;
; PDP-11 8-28K 1 TO 8 USER BASIC INTERPRETER
;
;	COPYRIGHT 1969, 1970, 1971, DIGITAL EQUIPMENT CORPORATION
;
;	WRITTEN BY DAVE KNIGHT AND JEFF SCOTT
;
;	THIS PROGRAM IS A PURELY EXPERIMENTAL PACKAGE WRITTEN
;	BY EMPLOYEES OF DIGITAL EQUIPMENT CORPORATION.  NO
;	WARRANTY OF ANY KIND IS HEREIN EXPRESSED OR IMPLIED.
;	ANY COMMENTS OR CRITICISMS OF THIS PROGRAM SHOULD
;	BE DIRECTLY ADDRESSED TO MR. DAVID KNIGHT, BLDG. 12-2,
;	DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754.
;
;	COPYING THE LISTING AND/OR BINARY TAPE SUPPLIED FOR THIS
;	PROGRAM IS EXPRESSLY FORBIDDEN WITHOUT THE PERMISSION
;	OF DIGITAL EQUIPMENT CORPORATION.
;
;
;
.	=	42
	.BYTE	001,'A	;VERSION 001A
;
; REGISTER ASSIGNMENTS
;
R0	=	%0		;TEMPORARY AND PARAMETER TRANSFER
R1	=	%1		;TEMPORARY AND PARAMETER TRANSFER
R2	=	%2		;SCRATCH
R3	=	%3		;SCRATCH
R4	=	%4		;SCRATCH
R5	=	%5		;USER LIST POINTER
SP	=	%6		;BASIC STACK POINTER
PC	=	%7		;PROGRAM COUNTER
;
; I/O DEVICE ASSIGNMENTS
;
TTY0	=	177564		;ADDRESS OF TTY0 STATUS REGISTER
KBD0	=	177560		;ADDRESS OF KBD0 STATUS REGISTER
LPT0	=	177514
HSR0	=	177550
HSP0	=	177554
KBD1	=	176500
KBD2	=	176510
KBD3	=	176520
KBD4	=	176530
KBD5	=	176540
KBD6	=	176550
KBD7	=	176560
TTY1	=	176504
TTY2	=	176514
TTY3	=	176524
TTY4	=	176534
TTY5	=	176544
TTY6	=	176554
TTY7	=	176564
STATUS	=	177776
;
; USER DATA AREA OFFSETS
;
TMPLN	=	-2	;TEMPORARY LINE NUMBER
INDEV	=	-4	;"INPUT" DEVICE
USRMSK	=	-6	;USER I/O SLOT MASK
IODEV	=	-10	;USER TERMINAL SLOT
M.I	=	-12	;RANDOM NUMBER GOODY
ENDUSR	=	-14	;END OF USER AREA
RNDM	=	-16	;ANOTHER RANDOM NUMBER GOODY
SAVF	=	-20	;OUTPUT FLAG
OLDF	=	-22	;INPUT FLAG
DATI	=	-24	;DATA STATEMENT POINTER
ENDTXT	=	-26	;END OF USER TEXT
RUNF	=	-30	;RUN FLAG
USR	=	-32	;USER AREA POINTER
LINENO	=	-34	;LINE NUMBER
HGHLN	=	-36	;HIGHEST LINE NUMBER IN PROGRAM
SLOT	=	-40	;POINTER TO USER'S SLOT TABLE
			;THIS MUST HAVE THE HIGHEST OFFSET TOO
;
; TRAP VECTOR CONTENTS
;
.	=	0		;START OF VECTORS
	JMP	GO		;BASIC RESTARTS AT LOCATION ZERO
TRP04:	.+2			;PROCESSOR ERROR - 4
	0
	.+2			;UNIMPLEMENTED INSTRUCTION - 10
	0
	.+2			;TRACE - 14
	0
	.+2			;IOT - 20
	0
	PWRFL			;POWER FAIL - 24
	0
	ERRR00			;EMT - 30
	0
	.+2			;TRAP - 34
	0
;
.	=	60		;SKIP OVER COMMUNICATIONS AREA
	KBDINT		;TELETYPE KEYBOARD - 60
	200
	TTYINT		;TELETYPE PRINTER - 64
	200
	HSR0IN		;HIGH SPEED READER - 70
	200
	HSP0IN		;HIGH SPEED PUNCH - 74
	200
;
; MULTI- USER RESTART
;
GO:	MOV	#GOLST,R0	;GET ADDRESS OF STACK LIST
GO1:	MOV	(R0)+,R1	;GET USER #N STACK POINTER
	BEQ	GO2		;QUIT WHEN DONE
	MOV	@R1,R2		;GET STACK POINTER
	MOV	#RESTRT,-(R2)	;SET RESTART
	CLR	-(R2)		;SET DUMMY R0
	MOV	R2,@R1		;RESET STACK POINTER TEMPORARILY
	BR	GO1		;LOOP UNTIL ALL SET UP
GO2:	JMP	RESTRT	;NOW RESET EVERYONE
;
GOLST:	STP
	STP1
	STP2
	STP3
	STP4
	STP5
	STP6
	STP7
	0
.	=	200
	LPT0IN		;LINE PRINTER - 200
	240
ENDVEC	=	.	;END OF ALL KNOWN VECTORS
PWRFL:	TST	PWR	;IS THE MACHINE COMING ON??
	BNE	PWR1		;NO
	INC	PWR		;YES
	RESET
	RESET
	RESET
	RESET
	RESET
	JMP	GO		;NOW GO DO IT
PWR1:	CLR	PWR		;POWER IS GOING AWAY SOON
	HALT
PWR:	1
;
; THE FOLLOWING IS A LIST OF IMPLEMENTED ERROR CALLS.  ALL ERRORS LESS
;	THAN "FENCE" ARE FATAL, ALL GREATER ARE NON-FATAL.
;
FENCE	=	100	;BOUNDARY BETWEEN FATAL AND NON-FATAL.
;
; FATAL ERROR CALLS
;
OVFERR	=	EMT+1		;USER STORAGE OVERFLOW - 0
UNRERR	=	OVFERR+2	;UNRECOGNIZED STATEMENT - 1
GOERR	=	UNRERR+2	;ILLEGAL GOTO OR GOSUB - 2
ILCERR	=	GOERR+2		;ILLEGAL CHARACTER TERMINATING STMT - 3
RETERR	=	ILCERR+2	;RETURN WITHOUT GOSUB - 4
SBSERR	=	RETERR+2		;BADLY FORMED SUBSCRIPT - 5
SUBERR	=	SBSERR+2	;SUBSCRIPT OUT OF RANGE - 6
PARERR	=	SUBERR+2	;MISMATCHED PARENTHESES - 7
LETERR	=	PARERR+2	;ILLEGAL LET - 8
OPRERR	=	LETERR+2	;ILLEGAL RELATIONAL OPERATOR IN IF - 9
IFERR	=	OPRERR+2	;ILLEGAL IF - 10
PRNERR	=	IFERR+2		;ILLEGAL PRINT - 11
LINERR	=	PRNERR+2	;NULL(S. U. BASIC ONLY) - 12
DIMERR	=	LINERR+2	;BAD DIMENSION - 13
DMVERR	=	DIMERR+2	;NOT ENOUGH ROOM IN STORAGE FOR THE ARRAY - 14
DEFERR	=	DMVERR+2	;BADLY FORMED DEFINE - 15
LNNERR	=	DEFERR+2	;ILLEGAL LINE NUMBER OR DIMENSION VALUE - 16
DMDERR	=	LNNERR+2	;DIM OF PREVIOUSLY DECLARED OR USED ITEM - 17
INPERR	=	DMDERR+2	;BAD VARIABLE IN INPUT LIST - 18
REAERR	=	INPERR+2	;BAD VARIABLE IN READ LIST - 19
RE1ERR	=	REAERR+2	;OUT OF DATA - 20
RE2ERR	=	RE1ERR+2	;BAD FORMAT IN A DATA STATEMENT - 21
FORERR	=	RE2ERR+2	;ILLEGAL FOR STATEMENT - 22
NXTERR	=	FORERR+2	;NO NEXT MATCHING FOR - 23
NXMERR	=	NXTERR+2	;NEXT WITHOUT FOR - 24
UNMERR	=	NXMERR+2	;UNMATCHED QUOTES IN STATEMENT - 25
EXFERR	=	UNMERR+2	;NULL(S. U. BASIC ONLY) - 26
ILFERR	=	EXFERR+2	;ILL FORMED EXPRESSION - 27
				;(PROBABLY MISSING EXPONENT ON E FORMAT NUMBER)
CLSERR	=	ILFERR+2	;ILLEGAL CLOSE - 28
OPNERR	=	CLSERR+2	;ANOTHER JOB OPENED TO THIS DEVICE - 29
SLTERR	=	OPNERR+2	;ILLEGAL SLOT - 30
UNDERR=SLTERR
NXDERR	=	SLTERR+2	;NON-EXISTENT DEVICE - 31
OP1ERR	=	NXDERR+2	;ALREADY OPEN - 32
DEVERR	=	OP1ERR+2	;ILLEGAL DEVICE IN OPEN - 33
BDFERR	=	DEVERR+2	;ILLEGAL OPERATION ON DEVICE - 34
RDYERR	=	BDFERR+2	;DEVICE NOT READY - 35
TM1ERR	=	RDYERR+2	;INTERROGATOR TABLE NOT SET UP - 36
TM2ERR	=	TM1ERR+2	;INTERROGATOR TABLE INDEX EXCEEDED - 37
;
; NON-FATAL ERROR CALLS
;
LOGERR	=	EMT+377	;LOG OF NEGATIVE OR ZERO NUMBER - 127
SQRERR	=	LOGERR-2	;SQUARE ROOT OF NEGATIVE NUMBER - 126
DVFERR	=	SQRERR-2	;DIV.-MUL. OVERFLOW OR UNDERFLOW - 125
FIXERR	=	DVFERR-2	;NUMBER TOO LARGE TO FIX - 124
NXVERR	=	FIXERR-2	;NON-EXISTENT VARIABLE - 123
IN1ERR	=	NXVERR-2	;TOO MUCH DATA TYPED - 122
IN2ERR	=	IN1ERR-2	;NOT ENOUGH DATA TYPED - 121
IN3ERR	=	IN2ERR-2	;ILLEGAL CHARACTERS ON INPUT - 120
WCLERR	=	IN3ERR-2	;WARNING - NO SLOT OPEN - 119
;
; END OF DIAGNOSTIC CALLS
;
;
.	=	400
;
; TRAP AND ERROR HANDLER
;	FATAL ERRORS WIPE OUT THE SYSTEM STACK AND RETURN TO THE
;	COMMAND INTERPRETER AFTER GIVING THE DIAGNOSTIC.  NON-FATAL
;	ERRORS RETURN TO THE CALLING ROUTINE.
;
;
ERRR00:	MOV	WORK,R3	;GET DATA AREA POINTER
	MOV	@SP,2(SP)	;REMOVE STATUS
	SUB	#2,@SP		;POINT TO EMT LOCATION
	MOV	@(SP)+,R2	;GET THE EMT INSTRUCTION
	ASR	R2
	BIC	#177600,R2	;GET ERROR CODE
	CLR	SAVF(R3)
	CMP	R2,#FENCE	;IS IT FATAL?
	BGT	ERRR01		;JUMP IF NON-FATAL
	CLR	OLDF(R3)
	MOV	ENDUSR(R3),SP	;ZAP THE STACK
	MOV	#STOP02,-(SP)	;GET NEW RETURN ADDRESS
ERRR01:	MOV	R1,-(SP)	;SAVE TEXT POINTER
	MOV	R2,R1
	MOV	#ERRR02,R0	;ASCII DESTINATION
	MOV	R1,-(SP)	;SAVE ERROR CODE
	JSR	PC,ITOA00
	JSR	PC,CRLF00
	MOV	#ERRR03,R0	;START OF MESSAGE
	JSR	PC,PRN00	;PRINT THE LINE
	MOV	#ERRR05,R0	;TAIL END OF MESSAGE
	JSR	PC,PRN00
	JSR	PC,PRLN00	;AND THE LINE NUMBER
	JSR	PC,CRLF00
	TST	(SP)+		;GET THE ERROR CODE
	BNE	ERRR04		;IS IT OVERFLOW?
	JSR	PC,CLRU00	;YES, CLEAR THE DATA AREA
ERRR04:	MOV	(SP)+,R1	;RESTORE R1
	RTS	PC		;AND RETURN
ERRR03:	.ASCII	/ERROR/
ERRR02:	.ASCII	/       /
ERRR05:	.ASCII	/AT LINE/
	.BYTE	0
	.EVEN
;
; END OF TRAP HANDLER

	.EOT		;END OF TAPE 1
;	SUPER BUFFERED I/O HANDLER
;
;	INSTRUCTIONS:
;
;	THIS IS A SLOT ORIENTED HANDLER.  IT HAS LITTLE OR NO
;	ERROR HANDLING CAPABILITY, BUT USES RING BUFFERS TO
;	GET THE I/O DONE QUICKLY.  IF IT IS DESIRED TO CHANGE
;	THE BUFFER LENGTH, IT IS ONLY NECESSARY TO INSERT MORE
;	SPACE IN THE BUFFER, THEREBY MOVING THE ENDING POINTER
;	FARTHER FROM THE BEGINNING POINTER.
;
;	THE KEYBOARD WILL ECHO TO THE TELEPRINTER WHEN IT IS
;	USED.  THE HANDLER RECOGNIZES ^U AND RUBOUT AND WILL
;	DELETE A LINE OR CHARACTER RESPECTIVELY.

;	TO DO INPUT, CALL "INPUT" WITH THE SLOT NUMBER IN
;	REGISTER #1, AND THE BUFFER ADDRESS IN R2.  UPON RETURN
;	FROM THE ROUTINE THE BUFFER WILL CONTAIN AN ASCII LINE
;	TERMINATED BY A LINE FEED.
;
;	BEFORE INPUT MAY BE DONE, THE SLOT MUST BE INITIALIZED.
;	THIS IS DONE BY CALLING "INITI" WITH THE SLOT NUMBER
;	IN R1.  THE HSR MUST BE RE-INITIALIZED AFTER EACH
;	PAPER TAPE IS READ.
;
;	THE OUTPUT SLOTS NEED NOT BE INITIALIZED BEFORE USE.
;
;
;
;

;
INITI:	ASL	R1		;MULTIPLY SLOT BY TWO
	MOV	SLOTSI(R1),R0	;GET THE BUFFER ADDRESS
	BEQ	INITI12		;NO INIT IF ZERO BUFFER
	MOV	B.GET(R0),B.PUT(R0)	;EMPTY IT
	CLR	B.STUS(R0)
	CLR	B.SPEC(R0)	;CLEAR MISC FLAGS
	TST	@(R0)		;CHECK FOR DEVICE NOT READY
	BMI	INITI3
	BIS	#101,@(R0)	;ENABLE READER
INITI1:	RTS	PC
INITI2:	BDFERR	;CAN'T INPUT FROM AN OUTPUT DEVICE
INITI3:	RDYERR		;NO TAPE IN READER!!!
;	BUFFER MANAGMENT ROUTINES

B.DEV	=	0	;DEVICE ADDRESS IS THE FIRST WORD
B.STRT	=	2	;START IS THE SECOND WORD OF THE BUFFER HEADER
B.END	=	4	;END IS THE THIRD WORD OF THE BUFFER HEADER
B.GET	=	6	;GET IS THE FOURTH WORD OF THE BUFFER HEADER
B.PUT	=	10	;PUT IS THE FIFTH WORD OF THE BUFFER HEADER
B.STUS	=	12	;STATUS IS THE SIXTH WORD OF THE BUFFER HEADER
B.SPEC	=	14	;SPECIAL WORD FOR READERS AND LINE COUNT


;	GTBYT--GET A BYTE OUT OF THE BUFFER
;		R0 POINTS TO THE BUFFER HEADER
;		R1 HAS THE CHARACTER UPON EXIT
;		THE V BIT IS SET IF NO BYTES ARE AVAILABLE

GTBYT:	CCC
	MOV	@#STATUS,-(SP)
	MOV	#340,@#STATUS
	MOV	B.GET(R0),R1	;GET POINTER TO R1
	CMP	R1,B.PUT(R0)	;SEE IF THERE IS ANYTHING IN THERE
	BEQ	B.GB01		;IF EQUAL THE BUFFER IS EMPTY
	MOVB	(R1)+,-(SP)	;GET THE BYTE
	CMP	R1,B.END(R0)	;SEE IF WE WRAPED AROUND
	BLOS	B.GB02		;IF OK THEN BYPASS 
	MOV	B.STRT(R0),R1	;WRAP AROUND
B.GB02:	MOV	R1,B.GET(R0)	;PUT AWAY THE NEW GET POINTER
	CLR	R1		;CLEAR R1
	BISB	(SP)+,R1	;GET THE BYTE
	MOV	(SP)+,@#STATUS
	RTS	PC		;AND RETURN
B.GB01:	MOV	(SP)+,@#STATUS
	SEV			;SET NOT FOUND
	RTS	PC		;AND RETURN

;	PTBYT--PUT A BYTE IN THE BUFFER
;		R0 POINTS TO THE BUFFER HEADER
;		R1 HAS THE CHARACTER
;		THE V BIT IS SET IF THE CHARACTER CAN NOT BE ENTERED

PTBYT:	CCC
	MOV	@#STATUS,-(SP)
	MOV	#340,@#STATUS
	MOV	R1,-(SP)	;SAVE R1 SO WE CAN USE A REGISTER LATTER
	MOV	B.PUT(R0),R1	;GET THE PUT POINTER
	INC	R1		;GET THE POSSIBLE NEW POSITION
	CMP	R1,B.END(R0)	;SEE IF IT WOULD WRAP AROUND
	BLOS	B.PB02		;SKIP IF OK
	MOV	B.STRT(R0),R1	;WRAP AROUND
B.PB02:	CMP	R1,B.GET(R0)	;SEE IF THERE IS ROOM
	BEQ	B.PB01		;IF EQUAL NO ROOM
	MOVB	(SP),@B.PUT(R0)	;STORE THE BYTE
	MOV	R1,B.PUT(R0)	;STORE THE NEW PUT POINTER
	MOV	(SP)+,R1	;RESTORE R1
	MOV	(SP)+,@#STATUS
	RTS	PC		;AND RETURN
B.PB01:	MOV	(SP)+,R1	;RESTORE R1
	MOV	(SP)+,@#STATUS
	SEV			;SHOW NO ROOM AT ALL!
	RTS	PC		;AND RETURN

;	BKBYT--BACKSPACE A BUFFER
;		R0 POINTS TO THE BUFFER HEADER
;		R1 CONTAINS THE DELETED CHARACTER UPON EXIT
;		THE V BIT IS SET IF THERE ARE NO BYTES AVAILABLE

BKBYT:	CCC
	MOV	@#STATUS,-(SP)
	MOV	#340,@#STATUS
	MOV	B.PUT(R0),R1	;GET THE PUT POINTER
	CMP	R1,B.GET(R0)	;SEE IF THERE'S ANYTHING
	BEQ	B.BB01		;BRANCH IF NONE
	MOVB	-(R1),-(SP)	;GET THE BYTE AND SAVE IT
	CMP	R1,B.STRT(R0)	;SEE IF WE WRAP AROUND
	BHIS	B.BB00		;BRANCH IF NO HARM
	MOV	B.END(R0),R1	;WRAP AROUND
B.BB00:	MOV	R1,B.PUT(R0)	;PUT AWAY THE POINTER
	CLR	R1
	BISB	(SP)+,R1	;GET THE BYTE
	MOV	(SP)+,@#STATUS
	RTS	PC
B.BB01:	MOV	(SP)+,@#STATUS
	SEV			;TELL HIM NOBODYS HOME
	RTS	PC

;	RTBYT--RETURN A BYTE TO THE BUFFER
;		R0 POINTS TO THE BUFFER HEADER
;		R1 IS THE BYTE TO BE RETURNED
;		THE V BIT SI SET IF THERE IS NO ROOM

RTBYT:	CCC
	MOV	@#STATUS,-(SP)
	MOV	#340,@#STATUS
	MOV	R1,-(SP)	;SAVE THE CHARACTER FOR LATTER
	MOV	B.GET(R0),R1	;GET THE GET POINTER
	DEC	R1		;BACK UP ONE BYTE
	CMP	R1,B.STRT(R0)	;SEE IF THIS IS STILL THE BUFFER
	BHIS	B.RB01		;IF OK THEN SKIP
	MOV	B.END(R0),R1	;WRAP ROUND
B.RB01:	CMP	R1,B.PUT(R0)	;SEE IF IT IS FULL
	BEQ	B.RB00		;IF EQUAL THEN FULL BUDDY!
	MOVB	(SP),(R1)	;STORE THE BYTE
	MOV	R1,B.GET(R0)	;UPDATE THE GET POINTER
	MOV	(SP)+,R1	;GET BACK THE OLD R1
	MOV	(SP)+,@#STATUS
	RTS	PC
B.RB00:	MOV	(SP)+,@#STATUS
	SEV			;SHOW A TIGHT SQUEZ
	RTS	PC

	.EOT		;END OF TAPE 2
I.ATB1:	.BYTE	177	;RUBOUT
	.BYTE	175	;ALT
	.BYTE	033	;ESC
	.BYTE	025	;^U
	.BYTE	017	;^O
	.BYTE	003	;^C
	.BYTE	015	;CR
	.BYTE	012	;LF
	.EVEN



;
; INTERNAL DEVICE OUTPUT SLOTS
;
SLOTSO:	.WORD	0	;SLOT 0 IS NO-OP
	.WORD	0	;SLOT 1 IS NO-OP
	.WORD	HSPBUF	;SLOT 2 IS HSP
	.WORD	LPTBUF	;SLOT 3 IS LPT
	.WORD	TTYBUF	;SLOT 4 IS TTY0
	.WORD	T1BUF	;SLOT 5 IS TTY1
	.WORD	T2BUF	;SLOT 6 IS TTY2
	.WORD	T3BUF	;SLOT 7 IS TTY3
	.WORD	T4BUF	;SLOT 8
	.WORD	T5BUF	;SLOT 9
	.WORD	T6BUF	;SLOT 10
	.WORD T7BUF	;SLOT 11



;
; INTERNAL DEVICE ASSIGNMENT TABLE
;
ATTACH:	.WORD	0	;SLOT 0 IS NO-OP
ATT1:	.WORD	0	;SLOT 1 IS HSR
ATT2:	.WORD	0	;SLOT 2
ATT3:	.WORD	0	;SLOT 3
	.WORD	1	;SLOT 4
	.WORD	2	;SLOT 5
	.WORD	4	;SLOT 6
	.WORD	10	;SLOT	7
	.WORD	20	;SLOT 8
	.WORD	40	;SLOT 9
	.WORD	100	;SLOT 10
	.WORD	200	;SLOT 11
ATT	=	.-ATTACH



;
; INTERNAL DEVICE INPUT SLOTS
;
SLOTSI:	.WORD	0	;SLOT 0 IS NO-OP
	.WORD	HSRBUF	;SLOT 1 IS HSR
	.WORD	0	;SLOT 2 IS NO-OP
	.WORD	0	;SLOT 3 IS NO-OP
	.WORD	KBDBUF	;SLOT 4 IS KBD0
	.WORD	K1BUF	;SLOT 5 IS KBD1
	.WORD	K2BUF	;SLOT 6 IS KBD2
	.WORD	K3BUF	;SLOT 7 IS KBD3
	.WORD	K4BUF	;SLOT 8 IS KBD4
	.WORD	K5BUF	;SLOT 9 IS KBD5
	.WORD	K6BUF	;SLOT 10 IS KBD6
	.WORD	K7BUF	;SLOT 11 IS KBD7
;
;
; DEVICE NAME TABLE
;	FIRST PART OF TABLE CONTAINS DEVICE NAMES, SECOND PART OF
;	TABLE CONTAINS INTERNAL SLOT ASSIGNMENTS
;
DEVNAM:	51742		;PTR - PAPER TAPE READER
	51740		;PTP - PAPER TAPE PUNCH
	37424		;LPT - LINE PRINTER
	64051		;TTY - TELETYPE
DEVEND	=	.
SLTPNT:	2		;INTERNAL SLOT 1
	4		;INTERNAL SLOT 2
	6		;INTERNAL SLOT 3
	-1		;USER'S TELETYPE SLOT



POS:	.WORD	0	;SLOT 0 POSITION
	.WORD	0	;SLOT 1
	.WORD	0	;SLOT 2
	.WORD	0	;3
	.WORD	0	;4
	.WORD	0	;5
	.WORD	0	;6
	.WORD	0	;7
	.WORD	0	;8
	.WORD	0	;9
	.WORD	0	;10
	.WORD	0	;11



POSMAX:	.WORD	0	;SLOT 0 MAX. POSITION
	.WORD	0	;1
	.WORD	77777	;2
	.WORD	117	;3
	.WORD	107	;4
	.WORD	107	;5
	.WORD	107	;6
	.WORD	107	;7
	.WORD	107	;8
	.WORD	107	;9
	.WORD	107	;10
	.WORD	107	;11

KBD0IN:	MOV	R2,-(SP)	;SAVE THE IMPORTANT REGISTERS
	MOV	R1,-(SP)
	MOV	R0,-(SP)
	MOV	2(R1),R1	;GET THE CHARACTER
	BIC	#177600,R1	;CLEAR THE PARITY BIT
	BEQ	I.KB06		;IF NULL IGNORE
	MOV	#I.ATB1,R2	;A TABLE OF SPECIAL CHARACTERS
	CMPB	R1,(R2)+
	BEQ	I.KB03		;IF EQUAL THEN <RUBOUT>
	BIT	#200,B.STUS(R0)	;SEE IF WE NEED A TRAILING _
	BEQ	I.KB00
	JSR	PC,I.PRBA	;PRINT A BACK ARROW(_)
	BIC	#200,B.STUS(R0)	;CLEAR RUBOUT FLAG
I.KB00:	CMPB	R1,(R2)+
	BGE	I.KB07		;IF EQUAL THEN <ALT>
	CMPB	R1,(R2)+
	BEQ	I.KB07		;IF EQUAL THEN <ESC>
	CMPB	R1,#140		;CONVERT LOWER CASE TO UPPER CASE
	BGE	I.KB0F
I.KB0G:	CMPB	R1,(R2)+
	BEQ	I.KB08		;IF EQUAL THEN <^U>
	CMPB	R1,(R2)+
	BEQ	I.KB09		;IF EQUAL THEN <^O>
	CMPB	R1,(R2)+
	BEQ	I.KB0A		;IF EQUAL THEN <^C>
	CMPB	R1,#20		;^P IS ALSO ALLOWED
	BEQ	I.KB0A
	CMPB	R1,(R2)+	;CONVERT <CR> TO <LF>
	BEQ	I.KB0D	;IF PRESENT
I.KB0E:	JSR	PC,PTBYT	;IF NOT SPECIAL THEN ENTER IT
	BVS	I.KB0Z		;BRANCH IF FULL
I.KB05:	SUB	#14,R0		;GO TO THE ECHO BUFFER
	JSR	PC,PTBYT	;ECHO IT A WELL
	ADD	#14,R0		;BACK TO THE KBD BUFF
	CMPB	R1,(R2)+
	BNE	I.KB06		;IF EQUAL THEN <LF>
	INCB	B.SPEC(R0)	;INCREMENT THE LINE COUNT
I.KB06:	BIS	#101,@(R0)	;RE-ENABLE THE READER
	BIS	#100,@-30(R0)	;TURN THE TTY ON FOR A STRECH
I.KB0C:	MOV	(SP)+,R0	;RESTORE THE REGS
	MOV	(SP)+,R1
	MOV	(SP)+,R2
	RTS	PC

I.PRBA:	MOV	R1,-(SP)	;SAVE THE CURRENT CHARACTER
	MOVB	#'_,R1		;GET READY FOR A _
	SUB	#14,R0		;GET TO THE ECHO BUFF
	JSR	PC,PTBYT
	ADD	#14,R0		;BACK TO THE KBD BUFF
	MOV	(SP)+,R1	;GET THE CHARACTER
	RTS	PC
I.KB0D:	SUB	#14,R0
	JSR	PC,PTBYT	;ECHO <CR>
	ADD	#14,R0
	MOVB	#12,R1		;CONVERT TO <LF>
	BR	I.KB0E
I.KB0F:	BIC	#40,R1		;CONVERT LOWER CASE TO UPPER CASE
	BR	I.KB0G
I.PRUP:	MOV	R1,-(SP)	;PUSH THE CHARACTER
	SUB	#14,R0		;GO TO THE ECHO BUFFER
	MOVB	#'^,R1		;GET THE ^ PART
	JSR	PC,PTBYT	;PRINT IT
	MOV	(SP)+,R1	;GET THE CHARACTER BACK
	ADD	#100,R1		;CONVERT TO ASCII
	JSR	PC,PTBYT	;PRINT IT
	MOVB	#015,R1		;INSERT A <CR><LF> TOO
	JSR	PC,PTBYT
	MOVB	#012,R1
	JSR	PC,PTBYT
	ADD	#14,R0		;BACK TO THE KBD BUFF
	RTS	PC
I.KB03:	BIT	#200,B.STUS(R0)	;SEE IF THIS IS THE FIRST ONE
	BNE	I.KB04
	JSR	PC,I.PRBA	;PRINT _
	BIS	#200,B.STUS(R0)	;SET RUBOUT IN PROGRESS
I.KB04:	JSR	PC,BKBYT	;SEE IF THERE IS ANY THING TO GET
	BVS	I.KB06
	CMPB	R1,#012
	BNE	I.KB05		;IF NOT A <LF> TYPE IT
	JSR	PC,PTBYT	;ELSE PUT IT BACK
	BR	I.KB06
I.KB07:	MOVB	#'$,R1		;ECHO A $
	SUB	#14,R0		;GO TO THE ECHO BUFF
	JSR	PC,PTBYT	;OUTPUT IT
	ADD	#14,R0		;BACK TO THE KBD BUFFER
I.KB0B:	JSR	PC,BKBYT
	BVS	I.KB06		;IF NONE EXIT
	CMPB	R1,#012
	BNE	I.KB0B		;IF NOT <LF> TRY AGAIN
	JSR	PC,PTBYT	;RETURN IT DUMBIE
	BR	I.KB06
I.KB08:	JSR	PC,I.PRUP	;PRINT ^U
	BR	I.KB0B		;HANDLE LIKE ALT AND ESC
I.KB09:	JSR	PC,I.PRUP	;PRINT ^O
I.KB10:	BIS	#10,B.STUS(R0)	;SET ^O FLAG
	BR	I.KB06		;AND EXIT
I.KB0A:	JSR	PC,I.PRUP
	BIS	#1,B.STUS(R0)	;TURN ON ^C FLAG
	BR	I.KB10		;AND EXIT
I.KB0Z:	MOVB	R1,B.SPEC+1(R0)	;SAVE THE CHARACTER
	BIS	#400,B.STUS(R0)	;TELL HIM WHAT WE DID
	BR	I.KB0C		;DON'T--I SAY DON'T ENABLE THE READER
;
; POLLING ROUTINE TO POLL MULTIPLE TELETYPES SHARING SAME VECTOR
;	ADDRESS (ALL = 60).
;
POLL:	MOV	R0,-(SP)	;SAVE SOME
	MOV	R1,-(SP)	; WORKING
	MOV	R2,-(SP)	;  REGISTERS
	MOV	(R5)+,R2	;GET ADDRESS OF TABLE
LOOP:	MOV	(R2)+,R0	;GET BUFFER ADDRESS
	BEQ	DONE		;IF ZERO WE ARE FINISHED HERE
	MOV	(R2)+,R1	;GET DEVICE ADDRESS
	TSTB	@R1	;CKECK FOR READY
	BPL	LOOP		;CHECK NEXT IF NOT READY
	BITB	#100,@R1	;BOTH READY AND ENABLE MUST BE SET
	BEQ	LOOP		;ENABLE NOT SET, GO TRY NEXT ONE
	JSR	PC,@(R5)	;GO TO PROPER INTERRUPT ROUTINE
	BR	LOOP		;NOW FINISH CHECKING
DONE:	TST	(R5)+
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RTS	R5
;
; KEYBOARD INTERRUPTS COME HERE
;
KBDINT:	JSR	R5,POLL	;GO DO IT TO THE KEYBOARDS
	.WORD	TABLK		;ADDRESS OF POINTER TABLE
	.WORD	KBD0IN		;ADDRESS OF DRIVER PROPER
	RTI
;
; TELEPRINTER INTERRUPTS COME HERE
;
TTYINT:	JSR	R5,POLL		;DO IT TO THE TTY ALSO
	.WORD	TABLT
	.WORD	TTY0IN
	RTI
;
; KEYBOARD INTERCEPT TABLE
;
TABLK:	KBDBUF
	KBD0
K1:	K1BUF
	KBD1
K2:	K2BUF
	KBD2
K3:	K3BUF
	KBD3
K4:	K4BUF
	KBD4
K5:	K5BUF
	KBD5
K6:	K6BUF
	KBD6
K7:	K7BUF
	KBD7
	0	;TABLE MUST BE TERMINATED BY ZERO
;
; TTY INTERCEPT TABLE
;
TABLT:	ECOBUF
	TTY0
T1:	E1BUF
	TTY1
T2:	E2BUF
	TTY2
T3:	E3BUF
	TTY3
T4:	E4BUF
	TTY4
T5:	E5BUF
	TTY5
T6:	E6BUF
	TTY6
T7:	E7BUF
	TTY7
	0

TTY0IN:	MOV	R0,-(SP)	;SAVE R0 AND R1
	MOV	R1,-(SP)	;FOR USE IN THE DRIVER
	JSR	PC,GTBYT	;SEE IF ANY BODY'S HOME
	BVC	T00		;IF V OFF WE GOT HIM
	SUB	#14,R0		;SEE ABOUT THE TTY BUFFER
T03:	JSR	PC,GTBYT	;ANY CHARACTERS HERE?
	BVS	T01		;ALL GONE!
	BIT	#10,B.STUS+30(R0)	;CHECK FOR THE ^O FLAG
	BNE	T03			;SKIP OUTPUT IF SET
T00:	MOV	(R0),R0		;GET DEVICE ADDRESS
	MOV	R1,2(R0)		;OUTPUT THE CHARACTER
T02:	MOV	(SP)+,R1	;RESTORE THE REGISTERS
	MOV	(SP)+,R0	;LIKE A GOOD LITTLE BOY
	RTS	PC		;WHITHER WANDEREST THOU WAYFARER
T01:	BIC	#100,@(R0)+	;TURN OFF THE BLOODY INTERRUPTS
	BR	T02		;AND EXIT

HSR0IN:	MOV	R0,-(SP)	;SAVE THE REGISTERS
	MOV	R1,-(SP)
	MOV	#HSRBUF,R0	;POINT TO THE HSR BUFF
	TST	HSR0		;TEST FOR EOF
	BMI	I.HR0X	;BRANCH IF ERROR
	MOV	HSR0+2,R1	;GET THE CHARACTER
	BIC	#177600,R1	;AND CLEAR PARITY
	BEQ	I.HR01		;IF NULL OR BLANK IGNORE IT
	CMP	R1,#177		;IF <RUBOUT> THROW AWAY
	BEQ	I.HR01
	CMPB	R1,#15
	BNE	I.HR03
	MOVB	#12,R1
	INCB	B.SPEC(R0)
	BR	I.HR02
I.HR03:	CMPB	R1,#12
	BNE	I.HR02
	BR	I.HR01		;THROW AWAY <LF>
I.HR02:	JSR	PC,PTBYT	;TRY TO PUT IT AWAY
	BVS	I.HR0Z		;IF FULL OH NO
I.HR01:	BIS	#101,HSR0	;RE-ENABLE THE READER
I.HR00:	MOV	(SP)+,R1
	MOV	(SP)+,R0	;RESTORE THE REGS
	RTI			;AND EXIT
I.HR0Z:	MOVB	R1,B.SPEC+1(R0)	;SAVE THE CHARACTER
	BIS	#400,B.STUS(R0)	;SHOW STOPPED READER
	BR	I.HR00
I.HR0X:	BIS	#1000,B.STUS(R0)	;SET EOF
	BR	I.HR00

HSP0IN:	MOV	R0,-(SP)	;SAVE THE REGS
	MOV	R1,-(SP)
	MOV	#HSPBUF,R0	;POINT TO THE HSP BUFF
	JSR	PC,GTBYT	;SEE IF ANY GOOD JUICE
	BVS	I.HP00
	MOV	R1,HSP0+2	;OUTPUT THE BYTE
I.HP01:	MOV	(SP)+,R1
	MOV	(SP)+,R0	;RESTORE THE REGS
	RTI
I.HP00:	BIC	#100,HSP0	;CLEAR THE INTERRUPTS
	BR	I.HP01

LPT0IN:	MOV	R0,-(SP)	;SAVE THE REGISTERS WE USE
	MOV	R1,-(SP)	;BOTH OF THEM
	MOV	#LPTBUF,R0	;SET UP THE POINTER TO LPTBUF
I.LP00:	JSR	PC,GTBYT	;GET A CHARACTER
	BVS	I.LP0Z		;IF EMPTY GET LOST
	CMPB	R1,#011		;SEE IF IT'S A <TAB>
	BNE	I.LP01		;IF NOT THEN GO PUT IT OUT
	TST	B.STUS(R0)	;SEE IF WE'VE PUT IN ENOUGH SPACES
	BMI	I.LP08		;IF WE HAVE THEN OK
	JSR	PC,RTBYT	;ELSE RETURN IT TO THE BUFFER
	MOV	#' ,R1		;PRINT A SPACE
	MOV	R1,LPT0+2	;OUTPUT THE CHARACTER
	ADD	#010000,B.STUS(R0)	;ADD ONE TO THE POSITION COUNTER
	BR	I.LP03		;FINISH UP
I.LP01:	CMPB	R1,#015		;SEE IF A POSITION MODIFIER
	BEQ	I.LP05
	CMPB	R1,#012		;<CR>,<LF>,<FF> ARE THE ONES
	BEQ	I.LP05
	CMPB	R1,#014
	BEQ	I.LP05
	ADD	#010000,B.STUS(R0)	;MOVE OVER ROVER
	BIC	#100000,B.STUS(R0)	;CLEAR CONFLICT WITH <TAB>
I.LP02:	MOV	R1,LPT0+2	;OUTPUT THE CHARACTER
I.LP03:	TSTB	LPT0		;SEE IF ONE OF 20
	BMI	I.LP00		;IF READY FEED HIM AGAIN
I.LP04:	MOV	(SP)+,R1	;RESTORE THE REGISTERS
	MOV	(SP)+,R0
	RTI
I.LP0Z:	BIC	#100,@(R0)
	BR	I.LP04		;TURN OFF INTERRUPTS AND RETURN
I.LP05:	BIC	#170000,B.STUS(R0)	;BACK TO POSITION ONE
	BR	I.LP02
I.LP08:	BIC	#170000,B.STUS(R0)	;CLEAR THE COUNTER
	BR	I.LP00		;GO GET ANOTHER

INPUT:	MOV	R2,-(SP)	;SAVE THE REGS
	MOV	R1,-(SP)
	MOV	R0,-(SP)
	MOV	WORK,R0
	BIT	USRMSK(R0),ATTACH(R1)	;DID USER ATTACH IT
	BEQ	I.INP1		;NO, NOT ALLOWED
	MOV	SLOTSI(R1),R0	;GET THE BUFFER ADDRESS
	BEQ	I.IN12
	BIC	#10,B.STUS(R0)	;CLEAR ^O
I.INP3:	BIT	#1,B.STUS(R0)		;WATCH FOR ^C
	BNE	I.INP4
	CCC
	MOV	@#STATUS,-(SP)
	MOV	#340,@#STATUS
	TSTB	B.SPEC(R0)	;SEE IF ANY LINES ARE HERE YET
	BEQ	I.INP0		;IF NONE THEN WAIT
	DECB	B.SPEC(R0)	;DECREMENT THE COUNT
	MOV	(SP)+,@#STATUS
I.INP5:	BIT	#1,B.STUS(R0)	;IS ^C SET?
	BNE	I.INP4		;YES, STOP EVERYTHING
	JSR	PC,GTBYT	;GET A BYTE
	BVS	I.IN11		;BAD - HORRIBLE ERROR
	BIT	#1,B.STUS(R0)	;IS ^C SET??
	BNE	I.INP4		;YES, STOP EVERYTHING
	MOVB	R1,(R2)+	;STORE IT
	CMPB	R1,#012		;SEE IF THAT'S IT
	BNE	I.INP5
	BIT	#400,B.STUS(R0)	;SEE IF WE STOPPED THE READER
	BEQ	I.INP2		;BRANCH IF NOT
I.INP8:	BIC	#400,B.STUS(R0)	;CLEAR THE STOPPED BIT AND RESTART IT
	MOVB	B.SPEC+1(R0),R1	;GET THE ALMOST FORGOTEN CHARACTER
	JSR	PC,PTBYT	;NOW THERE HAS TO BE ROOM
	BIS	#101,@(R0)	;RE-ENABLE THE READER
I.INP2:	MOV	(SP)+,R0	;RESTORE THE REGS
	MOV	(SP)+,R1
	MOV	(SP)+,R2
	RTS	PC		;AND RETURN
I.IN12:	BDFERR	;CAN'T INPUT FROM OUTPUT DEVICE
I.INP1:	UNDERR		;DEVICE UNATTACHED
I.INP9:	SLTERR		;SLOT ERROR
I.INP0:	MOV	(SP)+,@#STATUS
	BIT	#1000,B.STUS(R0)	;SEE IF EOF
	BNE	I.INP4
	BIT	#400,B.STUS(R0)	;SEE IF WE STOPPED THE READER
	BNE	I.INP6
	JSR	PC,IOWAIT
	BR	I.INP3		;SOMETHING HAPPENED. WAS IT FOR US
I.INP4:	MOV	(SP)+,R0	;RESTORE THE REGS
	MOV	(SP)+,R1
	MOV	(SP)+,R2
	SEV				;SET EOF
	RTS	PC		;AND RETURN
I.INP6:	JSR	PC,GTBYT	;GET A BYTE
	BVS	I.INP7		;EXIT WHEN EMPTY
	MOVB	R1,(R2)+	;STORE THE THING
	BR	I.INP6
I.INP7:	CLRB	(R2)+
	MOVB	#012,(R2)+	;SHOW BAD LENGTH
	BR	I.INP8
I.IN11:	HALT			;IF MACHINE HALTS HERE,
				;FIRST COPY CONTENTS OF ALL REGISTERS,
				;THEN GET A CORE DUMP ON THE
				;HSP USING DUMPAB.
				;ALSO DESCRIBE BRIEFLY WHAT WAS
				;HAPPENING AT THE TIME.  DO NOT
				;ATTEMPT TO CONTINUE FROM HERE.
				;A RESTART TO LOCATION 0 WILL BE
				;REQUIRED.

	.EOT			;END OF TAPE 3
;
;
; TSTCH - TST00, TEST ALPHABETIC VS NUMERIC IN R2
;	REGISTERS USED - R2
TST00:	CMP	R2,#'0		;CHECK NUMERIC
	BLT	TST03		;NON-NUMERIC
	CMP	R2,#'9		;CHECK ALPHA
	BGT	TST01		;NON-NUMERIC
	SEZ			;SET ZERO CODE IF NUMERIC
	RTS	PC
TST01:	CMP	R2,#'A		;ALPHABETIC?
	BLT	TST03		;NO
	CMP	R2,#'Z		;ALPHABETIC?
	BGT	TST03		;NO
	CCC			;SET NON-ZERO CODE IF ALPHABETIC
	RTS	PC
TST03:	CCC
	SEV			;SET
	RTS	PC		;OVERFLOW IF NEITHER
;
; INPUT HANDLER
;
PCK00:	MOV	WORK,R2		;GET DATA AREA POINTER
	TST	OLDF(R2)
	BEQ	PCK01
	MOV	OLDF(R2),R1	;GET INPUT SLOT
PCK01:	TST	R1		;CHECK FOR SELF
	BNE	PCK03		;NOT SELF
	MOVB	IODEV(R2),R1	;GET REAL SLOT
	ASL	R1		;
PCK04:	CLR	POS(R1)		;CLEAR LINE POSITION ON DEVICE
	MOV	WORK,R2
	JSR	PC,INPUT
	BVS	PCK02
	MOV	R2,R1
	RTS	PC
PCK02:	MOV	WORK,R2		;DATA AREA POINTER
	MOVB	IODEV(R2),R1
	JSR	PC,INITI	;INITIALIZE USER SLOT
	CLR	OLDF(R2)
	TST	(SP)+
	JMP	INIT00
PCK03:	TST	R1	;LEGAL SLOT??
	BLE	PCK05		;NO
	CMP	R1,#4		;TOO BIG?
	BGT	PCK05		;YES
	MOV	SLOT(R2),R2	;ADDRESS OF SLOT TABLE
	DEC	R1		;GET THE
	ASL	R1		;INDEX
	ADD	R1,R2		;FIND THE INTERNAL
	MOV	@R2,R1		; SLOT
	BR	PCK04
PCK05:	SLTERR
;
; PRINTC
;
PRNT09:	BDFERR		;CAN'T OUTPUT TO AN INPUT ONLY DEVICE
GETSLT:	MOV	WORK,R0
	TST	R1		;GOOD SLOT?
	BLE	PRNT07		;NO
	CMP	R1,#4		;TOO BIG?
	BGT	PRNT07		;YES
	DEC	R1		;COMPUTE
	ASL	R1		;TABLE INDEX
	MOV	SLOT(R0),R0	;GET THE SLOT POINTER
	ADD	R1,R0		;ADD THE INDEX
	MOV	@R0,R1		;GET THE REAL SLOT
	MOV	WORK,R0
	RTS	PC
PRNT01:	JSR	PC,GETSLT
	BR	PRNT08
PRNT00:	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	WORK,R0		;DATA AREA POINTER
	MOV	SAVF(R0),R1
	BNE	PRNT01
	MOVB	IODEV(R0),R1	;ASSUME SELF FOR SLOT 0
	ASL	R1	;GET EVEN VALUE FOR SLOT
PRNT08:	CMP	R1,#ATT		;SLOT TOO LARGE?
	BGE	PRNT07
	BIT	USRMSK(R0),ATTACH(R1) ;CHECK FOR ATTACHED
	BEQ	PRNT06		;NOT ATTACHED
	MOV	SLOTSO(R1),R0
	BEQ	PRNT09
	CMP	R1,#1		;CHECK FOR HSP
	BNE	PRNT04		;NOT HSP
	CLR	POS(R1)		;CLEAR HSP COUNT JUST IN CASE
				;OF REAL LO-O-O-O-NG LINE
PRNT04:	INC	POS(R1)
	CMP	POS(R1),POSMAX(R1)	;CHECK FOR LINE TOO LONG
	BLE	PRNT05
	MOV	R2,-(SP)
	MOV	R0,-(SP)
	JSR	PC,CRLF00
	MOV	(SP)+,R0
	MOV	(SP)+,R2
PRNT05:	MOV	WORK,R1
	INC	RNDM(R1)
	MOVB	IODEV(R1),R1	;EXIT
	ASL	R1		;QUICKLY
	MOV	SLOTSI(R1),R1	;IF
	BIT	#1,B.STUS(R1)	;A ^C
	BNE	PRNT02		;WAS TYPED
	MOV	R2,R1
	JSR	PC,PTBYT
	BVC	PRNT03
	JSR	PC,IOWAIT
	BR	PRNT05
PRNT03:	BIS	#100,@(R0)+
PRNT02:	MOV	(SP)+,R1
	MOV	(SP)+,R0
PRN01:	RTS	PC
PRNT06:	UNDERR		;UNATTACHED DEVICE
PRNT07:	SLTERR		;BAD SLOT
;
; ROUTINE TO TYPE <CR,LF>
;	REGISTER USED - R2.
;
CRLF00:	MOV	WORK,R0		;GET DATA AREA POINTER
	MOV	SAVF(R0),R0	;GET DEVICE
	BNE	CRLF01		;JUMP IF NOT USER TTY
	MOV	WORK,R0		;GET
	MOV	IODEV(R0),R0	;THE USER
	ASL	R0		;TELETYPE ADDRESS
CRLF02:	MOV	#-2,POS(R0)	;CLEAR THE POSITION FLAG
	MOV	#RDY01,R0	;GET ADDRESS OF <CR,LF>
;
; PRINTL - PRN00 - PRINT A LINE OF ASCII
;	R0 HAS STARTING ADDRESS, LINE IS TERMINATED BY A ZERO BYTE
;	REGISTERS USED - R0,R2.
PRN00:	MOVB	(R0)+,R2	;GET A CHARACTER
	BEQ	PRN01		;EXIT IF DONE
	JSR	PC,PRNT00
	BR	PRN00		;LOOP
;
CRLF01:	MOV	R1,-(SP)	;SAVE R1
	MOV	R0,R1		;GET EXTERNAL SLOT
	JSR	PC,GETSLT	;CONVERT TO INTERNAL SLOT
	MOV	R1,R0		;GET INTERNAL SLOT
	MOV	(SP)+,R1	;RESTORE R1
	BR	CRLF02		;GO BACK TO MAIN LINE
;
; SKIP - SKIP00, SKIP OVER BLANKS IN WORKING STORAGE, R1 POINTS
;  TO LINE POSITION, CHARACTER FOUND GOES TO R2
;	REGISTERS USED - R1,R2.
;
SKIP00:	MOVB	(R1)+,R2	;GET A CHARACTER
	CMPB	#' ,R2		;IS IT BLANK?
	BEQ	SKIP00		;YES, GET ANOTHER
	RTS	PC
;
; JUNKIT - JUNK00, SKIP OVER REMAINDER OF LINE
;	UNTIL <LF> OR ":" IS FOUND.
;  R1 POINTS TO TERMINATOR ON EXIT.
;	REGISTERS USED - R1.
;
JUNK00:	CMPB	@R1,#':		;IS CHARACTER A ":"?
	BEQ	JUNK01		;JUMP IF YES
	CMPB	(R1)+,#12	;IS IT A <LF>?
	BNE	JUNK00		;NO, LOOK AGAIN
	DEC	R1		;YES, BACK UP POINTER ONE PLACE
JUNK01:	RTS	PC
;
; CLRUSR - CLRU00, CHECK FOR EXISTENCE OF USER SPACE, AND DELETE
;  IT IF PRESENT.  REGISTERS USED - R5.
;
CLRU00:	MOV	R0,-(SP)	;SAVE R0
	MOV	WORK,R0		;GET DATA POINTER
	CLR	DATI(R0)	;CLEAR OUT DATA POINTER
	TST	ENDTXT(R0)	;IS THE USER SPACE SET UP?
	BEQ	CLRU01		;JUMP IF NOT
	MOV	ENDTXT(R0),R5	;DELETE IT
	CLR	ENDTXT(R0)	;  IF IT IS.
CLRU01:	MOV	(SP)+,R0	;RESTORE R0
	RTS	PC
;
; PSHNAM, PSH00 - PUSH A DUMMY VARIABLE ON THE USER LIST
;
PSH00:	JSR	PC,PUSH00		;PUT THE NAME ON THELIST
	MOV	#14,R0		;PUT LENGTH OF 14
	JSR	PC,PUSH00	;IN WORD 2
	CLR	R0		;CLEAR A CELL
	JSR	PC,PUSH00		;PUSH A ZERO DIMENSION
	MOV	R5,R0
	JSR	PC,PUSH00		;PUSH THREE MORE
	JSR	PC,PUSH00		;NOTHINGS ON
	JSR	PC,PUSH00	;THE USER LIST
	RTS	PC		; AND RETURN
;
; PUTAWY, PUT00 - PUSH A VALUE ON THE USER LIST
;
PUT00:	MOV	R2,R0		;PUT
	JSR	PC,PUSH00	; THE
	MOV	R3,R0		;  VALUE
	JSR	PC,PUSH00	;   AWAY
	MOV	R4,R0		;    PROPERLY
	JSR	PC,PUSH00
	RTS	PC		;AND RETURN
;
; PUSH - PUSH00, PUSH ONE WORD IN R0 ON USER STORAGE LIST
;	IF ENDTXT=0 ON ENTRY, SAVE R5 IN ENDTXT FIRST
;	IF R5 IS ODD, MOVE TO NEXT EVEN BOUNDARY
;	R5 IS UPDATED WHEN ITEM IS PLACED ON THE LIST
;	REGISTERS USED - R0,R5.
;
PUSH00:	MOV	R2,-(SP)	;SAVE R2
	MOV	R4,-(SP)	;SAVE R4
	MOV	R5,R4
	ADD	#70,R4		;ADD FUDGE TO CHECK
	CMP	R4,SP
	BHIS	PUSH02
	MOV	WORK,R2		;GET DATA AREA POINTER
	TST	ENDTXT(R2)	;IS USER AREA INTACT
	BNE	PUSH01		;YES, SKIP OVER INIT.
	MOV	R5,ENDTXT(R2)	;OTHERWISE REMEMBER WHERE TEXT ENDS
	INC	R5		;MAKE THE
	ASR	R5		; ADDRESS
	ASL	R5		;  AN EVEN NUMBER
PUSH01:	MOV	R0,(R5)+	;PUT ONE WORD ON THE LIST
	MOV	(SP)+,R4	;RESTORE R4
	MOV	(SP)+,R2
	RTS	PC
PUSH02:	OVFERR
;
; SRLST - SRL00, SEARCH USER STORAGE FOR THE FIRST ITEM HAVING THE
;	CLASS AS SPECIFIED IN R4.  THE ADDRESS OF THE FOUND ITEM IS
;	RETURNED IN R3.  UPON ENTRY, R3 MUST POINT TO THE START ADDRESS
;	OF THE LIST.  REGISTERS USED - R0,R1,R2,R3,R4.
;	AND R0 IS A MASK OF BITS TO IGNORE IN THE HEADER.
;
SRL01:	MOV	@R3,R0		;GET ITEM ON TOP OF LIST
	BIC	@SP,R0		;CLEAR OUT THE JUNK
	CMP	R0,R4		;ARE THE CLASSES THE SAME?
	BEQ	SRL05		;EXIT IF YES
	BIC	#017777,R0	;NOW MASK OFF ALL OTHER STUFF
	CMP	#040000,R0	;FIND THE CURRENT CLASS
	BNE	SRL02		;JUMP IF NOT CLASS TWO
	ADD	#20,R3		;JUMP OVER 8 ITEMS FOR CLASS TWO
	BR	SRL08
SRL00:	TST	R3
	BEQ	SRL06
	CMP	R5,SP
	BHIS	PUSH02
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	MOV	R0,-(SP)	;SAVE MASK
SRL08:	CMP	R3,SP		;HAS THE SEARCH OVERFLOWED?
	BHIS	PUSH02		;YES, GO AWAY AND DIE NICELY
	CMP	R3,R5		;OUT OF SPACE?
	BLO	SRL01		;NO
	CLR	R3		;YES, QUIT - SET NOT FOUND
SRL05:	MOV	(SP)+,R0	;RESTORE MASK
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	TST	R3		;SET STATUS BITS ON RESULT OF SEARCH
SRL06:	RTS	PC
SRL02:	BGT	SRL03		;JUMP IF CLASS 0 OR 1
	ADD	#6,R3		;CLASS 3 HERE - SKIP OVER ITEM
	BR	SRL08		;AND RE-LOOP
SRL03:	TST	R0		;CHECK FOR CLASS 0
	BEQ	SRL04
	TST	(R3)+		;CLASS ONE, SKIP ITEM
	BR	SRL08		;AND RETURN
SRL04:	ADD	2(R3),R3	;SKIP ARRAY OR VARIABLE
	BR	SRL08
;
; ARYLG - ARYL00, COMPUTE ARRAY LENGTH - FIRST DIM IN R0, SECOND IN
;	R1, RESULT RETURNED IN R0.  REGISTERS USED - R0,R1,R2,R3.
;
ARYL00:	BIC	#177400,R0	;CLEAR BOTH
	BIC	#177400,R1	;SIGN EXTENSIONS IF ANY
	INC	R0		;ADD ONE
	INC	R1		; TO EACH AND
	MOV	R4,-(SP)
	MOV	R3,-(SP)
	JSR	PC,IMUL00	;MULTIPLY THEM
	MOV	(SP)+,R3
	MOV	(SP)+,R4
	TST	R1		;DID THE MULTIPLY GET TOO BIG???
	BNE	ARYL01		;JUMP IF YES
	CMP	R0,#22000	;IS ARRAY LONGER THAN IS POSSIBLE?
	BHIS	ARYL01
	JSR	PC,MLS00	;MULTIPLY RESULT BY SIX
	CCC
	RTS	PC		;RETURN
ARYL01:	SEV
	RTS	PC		;SET ERROR IF IMPOSSIBLE ARRAY
;
; SCRNCH - SCR00, DELETE THE NUMBER OF BYTES FROM THE USER STORAGE
;	SPECIFIED BY R4.  R3 POINTS TO STARTING POINT FOR THE
;	DELETION.  REGISTERS USED - R1,R2,R3,R4,R5.
;
SCR00:	MOV	R3,R1		;GET TWO
	MOV	R1,R2		;COPIES OF THE POINTER
	ADD	R4,R1		;RESET THE REAL POINTER
	BR	SQU01		;GO SQUISH IT
;
; SQUISH - SQU00, DELETE ONE LINE OF TEXT POINTED TO BY R1
;  R1 IS NOT DESTROYED, R2 AND R3 ARE USED FOR SCRATCH
; R5 IS UPDATED WHEN DONE.  REGISTERS USED - R1,R2,R3,R5.
;
SQU00:	JSR	PC,CLRU00	;CLEAR THE USER SPACE IF ANY
	MOV	R1,R3		;GET TWO COPIES
	MOV	R1,R2		; OF THE POINTER
	CMPB	(R1)+,(R1)+	;SKIP OVER LINE NUMBER
	JSR	PC,SRCH00	;FIND END OF LINE
SQU01:	CMP	R1,R5		;CHECK COMPLETION OF SQUEEZE
	BHIS	SQU02		;JUMP IF DONE
	MOVB	(R1)+,(R3)+	;MOVE A CHARACTER
	BR	SQU01		;MOVE THE WHOLE CHUNK
SQU02:	MOV	R3,R5		;UPDATE USER POINTER
	MOV	R2,R1		;RESTORE R1
	RTS	PC
;
; SRCHLF - SRCH00, SEARCH FOR <LF>, POINTER IN R1, WHEN DONE R1
;  POINTS ONE BYTE AFTER THE <LF>.  REGISTERS USED - R1.
;
SRCH00:	CMPB	(R1)+,#12	;IS THIS CHAR A LINE FEED?
	BNE	SRCH00		;NO
	RTS	PC
;
; FINDLN - FIND00, FIND THE LINE NUMBER IN THE TEXT WHICH CORRESPONDS
;  TO THE NUMBER SPECIFIED IN R0.  IF FOUND, SET ZERO CODE AND RETURN,
;  R1 POINTS TO BEGINNING OF LINE.  IF NOT FOUND, SET NON-ZERO, RETURN
;  WITH R1 POINTING TO THE LOGICAL INSERTION POINT FOR A NEW
;  LINE WITH THE SPECIFIED NUMBER.  
;  REGISTERS USED - R0,R1,R2,R3,R4,R5.
;
FIND00:	MOV	WORK,R1		;GET DATA AREA POINTER
	MOV	USR(R1),R1	;START LOOKING AT BEGINNING OF TEXT
FIND01:	JSR	PC,SRCH00	;GO TO START OF LINE
	CMP	R1,R5
	BHIS	FIND05		;JUMP IF END OF TEXT
	MOV	WORK,R2		;GET ADDRESS
	TST	-(R2)		;OF TEMP LINE
	MOVB	@R1,(R2)+	;GET THE
	MOVB	1(R1),(R2)+	;LINE NUMBER ASSEMBLED
	MOV	-(R2),-(SP)	;GET THE WHOLE NUMBER
	MOV	R0,(R2)+	;REPLACE IT
	MOV	(SP)+,R2	;PLACE NUMBER IN R2
	CMP	R0,R2		;DO LINE NUMBERS MATCH?
	BEQ	FIND03		;YES
	BLE	FIND02		;KEEP LOOKING
	CMPB	(R1)+,(R1)+	;SKIP OVER LINE NUMBER
	BR	FIND01
FIND02:	CCC			;SET NOT EQUAL
FIND03:	RTS	PC
FIND05:	CCC
	SEV			;SET OVERFLOW ON OVERFLOW
	RTS	PC
;
; GETVAR - GETV00, GET A VARIABLE AND PACK IT IN TRUNCATED ASCII INTO
;	R4.  ON RETURN R4 HAS VARIABLE, R2 HAS NEXT CHARACTER.
;	REGISTERS USED - R1,R2,R4.
;
GETV00:	JSR	PC,SKIP00	;GET A CHARACTER
	JSR	PC,TST00	;ALPHABETIC?
	BEQ	FIND05		;NO
	BVS	FIND05		;NO
	BIC	#177700,R2	;TRUNCATE IT
	MOV	R2,R4		;AND
	SWAB	R4		;PACK IT IN
	ASR	R4		;THE
	ASR	R4		;HEADER WORD
	JSR	PC,SKIP00	;GET NEXT CHARACTER
	JSR	PC,TST00	;NUMERIC?
	BNE	FIND02		;NO
	BIS	R2,R4		;YES, ZOT IT INTO THE HEADER
	JSR	PC,SKIP00	;GET ANOTHER CHARACTER
	BR	FIND02
;
; DIMCHK - DIMC00, MAKE SURE DIMENSION IN R0 IS IN BOUNDS 0 TO 255
;	REGISTERS USED - R0.
;
DIMC00:	TST	R0		;DIM .LT. 0?
	BLT	FIND02		;YES
	CMP	R0,#377		;GREATER THAN 255?
	BGT	FIND02		;YES
	SEZ			;SET EQUAL CODE IF IN BOUNDS
	RTS	PC
;
; GETNUM - GET00, GET PARAMETERS FOR COMMAND
;  R1 POINTS TO START OF USER AREA, R3 RETURNS FIRST PARAMETER, R4
;  RETURNS SECOND.  REGISTERS USED - R0,R1,R2,R3,R4.
;
GET00:	JSR	PC,SKIP00	;GET ONE CHARACTER
	JSR	PC,TST00	;IS IT NUMERIC
	BNE	GET01		;NO, LOOK FOR COMMA
	DEC	R1		;YES, REPOSITION CHARACTER POINTER
	JSR	PC,ATOI00	;CONVERT FIRST ARGUMENT
	MOV	R0,-(SP)	;SAVE IT
	JSR	PC,SKIP00	;GET THE SEPARATOR
GET04:	CMP	#',,R2		;IS IT A REAL SEPARATOR?
	BNE	GET02		;NO
	JSR	PC,ATOI00	;CONVERT SECOND ARGUMENT
	TST	R0
	BEQ	GET02		;SECOND PARAMETER IS ZERO
	MOV	R0,R4
GET03:	MOV	(SP)+,R3	;SET UP FIRST ARGUMENT
	RTS	PC
GET01:	CLR	-(SP)		;NO ARGUMENTS
	BR	GET04
GET02:	CLR	R4		;SET THEM TO ZERO
	BR	GET03
;
; SAVE, OLD
;
SAVE00:	JSR	PC,ATOI00	;GET DEVICE NUMBER
	MOV	WORK,R2		;GET ADDRESS OF DATA AREA
	MOV	R0,SAVF(R2)
	JMP	LIST00
OLD00:	JSR	PC,ATOI00	;GET SLOT NUMBER
	MOV	WORK,R2		;GET DATA AREA ADDRESS
OLD03:	MOV	R0,OLDF(R2)	;PUT IT AWAY
	BEQ	OLD02		;SKIP IF NOTHING DOING
	MOV	SLOT(R2),R1	;GET THE SLOT TABLE POINTER
	TST	R0		;GOOD SLOT?
	BLE	BADOLD	;NO
	CMP	R0,#4		;SLOT TOO BIG?
	BGT	BADOLD		;YES
	DEC	R0		;COMPUTE
	ASL	R0		;THE INDEX
	ADD	R0,R1
	MOV	@R1,R1		;GET REAL SLOT FOR INIT
	ASR	R1
OLD04:	JSR	PC,INITI
	MOV	USR(R2),R5	;DELETE THE WHOLE
	INC	R5
	CLR	ENDTXT(R2)
	JSR	PC,STAT		;GET STATUS ADDRESS
	BIC	#1,B.STUS(R0)	;TURN OFF ^C
	CLR	LINENO(R2)
OLD01:	JMP	INIT03
OLD02:	MOV	IODEV(R2),R1	;SELF IF ZERO
	BR	OLD04
BADOLD:	SLTERR
STAT:	MOV	WORK,R0		;GET DATA AREA ADDRESS
	MOVB	IODEV(R0),R0	;GET USER'S SLOT
	ASL	R0
	MOV	SLOTSI(R0),R0	;GET STATUS POINTER
	RTS	PC
;
; TSTOK - TSTU00, CHECK FOR POSSIBLE USER STORAGE OVERFLOW
;  R0 HAS NUMBER OF BYTES TO ENTER.  REGISTERS USED - R0,R3,R4,R5.
;
TSTU00:	MOV	R5,R4		;GET END OF USER STORAGE
	ADD	R0,R4		;COMPUTE EXTENSION
	MOV	SP,R3		;GET SP POSITION
	SUB	#70,R3		;SUBTRACT EXPANSION FUDGE
	CMP	R3,R4		;IF SP-FUDGE .GE. R5+R0 ALL IS OK
	RTS	PC
;
; SUBSCR - SUBS00, COMPUTE A SUBSCRIPT EXPRESSION - UPON ENTRY, R1
;	POINTS TO THE ASCII CHARACTER STRING STARTING WITH THE
;	LEFT PAREN, R3 POINTS TO THE ADDRESS OF TWO STANDARD FORMAT
;	SUBSCRIPTS.  UPON EXIT, R0 POINTS TO THE DESIRED LOCATION
;	R3 IS UNCHANGED, AND R1 POINTS TO A NON-BLANK CHARACTER
;	FOLLOWING THE CLOSED PAREN.
;	REGISTERS USED - R0,R1,R2,R3,R4.
;
SUBS00:	MOV	R3,-(SP)
	JSR	PC,EVAL00	;EVALUATE THE FIRST SUBSCRIPT
	BVS	SUBS01		;SKIP IF PAREN FOUND
	CMPB	@R1,#',		;OTHERWISE MAKE SURE
	BNE	SUBS98		;COMMA IS THERE
	JSR	PC,SUBS03
	JSR	PC,SKIP00	;YES
	MOV	R0,-(SP)	;SAVE VERIFIED SUBSCRIPT
	JSR	PC,EVAL00	;GET THE SECOND SUBSCRIPT
	BVC	SUBS98		;JUMP IF NO CLOSED PAREN
	JSR	PC,FIX00	;AND FIX IT
	BMI	SUBS99
	MOV	(SP)+,R2	;GET THE
SUBS02:	MOV	@(SP),R4	;SECOND
	BIC	#177400,R4	;SUBSCRIPT LIMIT
	CMP	R0,R4		;OUT OF RANGE?
	BGT	SUBS99		;YES
	MOV	R1,-(SP)	;NO, SAVE TEXT POINTER
	MOV	R2,R1		;FIRST SUBSCRIPT
	MOV	R0,-(SP)	;SAVE SECOND SUBSCRIPT
	MOV	R4,R0		;GET Y.MAX
	INC	R0
	JSR	PC,IMUL00	;GET X*(Y.MAX+1)
	ADD	(SP)+,R0	;COMPUTE ACTUAL POSITION OF VARIABLE
	JSR	PC,MLS00	;  HERE AND MULTIPLY BY SIX
	MOV	(SP)+,R1	;RESTORE CHARACTER POINTER
	ADD	@SP,R0		;COMPUTE
	TST	(R0)+		; ABSOLUTE ADDRESS OF NUMBER
	MOV	(SP)+,R3	;RESTORE R3
	RTS	PC
SUBS01:	JSR	PC,SUBS03
	MOV	R0,R2		;SAVE FIRST SUBSCRIPT
	CLR	R0		;SET SECOND SUBSCRIPT TO ZERO
	BR	SUBS02		;GO BACK TO MAIN LINE
SUBS98:	SBSERR			;BADLY FORMED SUBSCRIPT
SUBS99:	SUBERR			;SUBSCRIPT OUT OF RANGE
SUBS03:	JSR	PC,FIX00	;FIX IT
	BMI	SUBS99
	MOV	@2(SP),R4	;GET BOTH SUBSCRIPT LIMITS
	SWAB	R4		;I WANT THE FIRST ONE ONLY
	BIC	#177400,R4	; ONLY
	CMP	R0,R4		; OUT OF RANGE?
	BGT	SUBS99		;YES
	RTS	PC
	.EOT			;END OF TAPE 4
;
; PRNTLN - PRLN00 - PRINT LINE NUMBER
;	REGISTERS USED - R0,R1,R2,R3,R4.
;
PRLN00:	SUB	#12,SP		;DESTINATION
	MOV	SP,R0		;  IS ON THE STACK
	MOV	WORK,R1		;DATA AREA
	MOV	LINENO(R1),R1	;SOURCE
	JSR	PC,ITOA00	;CONVERT TO ASCII
	MOV	SP,R0		;PRINT THE RESULTING
	JSR	PC,PRN00	;PRINT NUMBER
	ADD	#12,SP		;RESTORE THE STACK
	RTS	PC
;
; MULSIX - MLS00, MULTIPLY R0 BY SIX.  REGISTERS USED - R0.
;
MLS00:	ASL	R0		;MULTIPLY BY TWO
	MOV	R0,-(SP)	;SAVE IT
	ASL	R0		;NOW MAKE IT 4X
	ADD	(SP)+,R0	;4X+2X=6X
	RTS	PC
;
; TXTADR - TXT00, GET EVEN START OF USER STORAGE TO R3
;	REGISTERS USED - R3.
;
TXT00:	MOV	WORK,R3		;DATA AREA
	MOV	ENDTXT(R3),R3	;GET END OF TEXT
	INC	R3
	ASR	R3		;ROUND
	ASL	R3		;  UP TO NEXT EVEN ADDRESS
	RTS	PC
;
; TWOCHR - TWO00, PACK NEXT TWO CHARACTERS IN R4.
;	REGISTERS USED - R1,R2,R4.
;
TWO00:	JSR	PC,SKIP00	;GET FIRST CHARACTER
	MOV	R2,R4		;PUT IT IN
	SWAB	R4		; HIGH BYTE OF R4
	JSR	PC,SKIP00	;GET SECOND CHARACTER
	BIS	R2,R4		; AND PACK IT TOO.
	RTS	PC
;
; MOVSTK - MOVS00, MOVE REGISTERS R4,R3, AND R2 ON THE STACK
;
MOVS00:	MOV	R3,-(SP)	;PUT
	MOV	R2,-(SP)	; THE
	MOV	4(SP),-(SP)	;  STUFF
	MOV	R4,6(SP)	;   ON THE STACK
	CMP	R5,SP		;DID WE OVERFLOW?
	BHIS	MOVS01		; YES
	RTS	PC		; NO
MOVS01:	OVFERR			;OVERFLOW
; PDP-11 BASIC, COMMAND EXECUTION ROUTINES
;
; LIST - LIST00, LIST THE SOURCE TEXT
;	REGISTERS USED - R0,R1,R2,R3,R4,R5.
;
LIST00:	JSR	PC,CLRU00
	JSR	PC,GET00	;GET THE PARAMETERS
	MOV	R3,R0
	BNE	LIST03
LIST05:	MOV	WORK,R3		;DATA AREA ADDRESS
	MOV	USR(R3),R3
	TST	R4		;IS SECOND PARAMETER ZERO ALSO?
	BNE	LIST07		;NO
LIST04:	MOV	R5,R4
LIST01:	JSR	PC,STAT		;DID HE
	BIT	#1,B.STUS(R0)	;TYPE ^C????
	BNE	LIST14		;YES, QUIT WHAT IS GOING ON
	MOVB	(R3)+,R2	;GET CHARACTER
	CMPB	R2,#140		;IS IT A PACKED VERB?
	BLT	LIST08		;JUMP IF NOT
	SUB	#140,R2		;GENERATE VERB NUMBER
	MOV	#INIT11,R0	;GET PROTOTYPE LIST
	MOV	R2,R1
LIST09:	DEC	R1		;DECREMENT VERB COUNT
	BLT	LIST11		;IF FOUND GO PRINT THE VERB
LIST10:	CMPB	(R0)+,#'$	;FIND PROTOTYPE END TO GET TO
	BNE	LIST10		; THE NEXT
	BR	LIST09		;  VERB IN THE LIST
LIST11:	MOVB	(R0)+,R2	;GET A CHARACTER
	CMPB	R2,#'$		;QUIT IF END OF PROTOTYPE
	BEQ	LIST01
	JSR	PC,PRNT00	;OTHERWISE TYPE THE CHARACTER
	BR	LIST11
LIST08:	CMPB	R2,#12		;LINE TERMINATOR?
	BEQ	LIST02
	JSR	PC,PRNT00
	BR	LIST01		;RE-LOOP
LIST02:	JSR	PC,CRLF00	;OUTPUT <CR,LF>
	CMP	R3,R4
	BHIS	LIST15
	MOV	R4,-(SP)
	MOV	WORK,R4		;DATA AREA POINTER TO GET TMPLN
	MOVB	(R3)+,LINENO(R4)	;STORE NUMBER
	MOVB	(R3)+,LINENO+1(R4)	;IN LINENO
	MOV	R3,-(SP)
	JSR	PC,PRLN00	;TYPE THE LINE NUMBER
	MOV	(SP)+,R3	;RESTORE R3
	MOV	(SP)+,R4	;AND R4
	BR	LIST01
LIST15:	MOV	WORK,R0		;CLEAR THE
	CLR	LINENO(R0)	;LINE NUMBER
	JMP	INIT26		;NO
LIST03:	MOV	R4,-(SP)	;SAVE R4
	JSR	PC,FIND00	;FIND START LINE
	MOV	(SP)+,R4	;RESTORE R4
	CMP	R1,R5		;NO SUCH LINE?
	BHIS	LIST05		;NO SUCH LINE FOUND
	MOV	R1,R3		;START ADDRESS TO R3
LIST07:	CMP	R4,R0		;CHECK LAST ARGUMENT AGAINST FIRST
	BLE	LIST06		;JUMP IF .LE. FIRST ARGUMENT
	MOV	R4,R0
	MOV	R3,-(SP)	;
	JSR	PC,FIND00	;GET POSITION OF SECOND LINE
	BNE	LIST12
	MOV	(SP)+,R3
	CMP	R1,R5		;AT END OF TEXT?
	BHIS	LIST04		;YES
LIST06:	CMPB	(R1)+,(R1)+	;SKIP OVER LINE NUMBER
	JSR	PC,SRCH00	;NO, FIND END OF CURRENT LINE
LIST13:	MOV	R1,R4
	BR	LIST02
LIST12:	MOV	(SP)+,R3
	CMP	R1,R5
	BHI	LIST04
	BR	LIST13
LIST14:	BR	INIT01
;
; DELETE, DEL00, DELETE TEXT AS SPECIFIED BY THE COMMAND PARAMETERS
;	REGISTERS USED - R0,R1,R2,R3,R4,R5.
;
DEL00:	JSR	PC,CLRU00	;CLEAR THE USER AREA JUST IN CASE
	JSR	PC,GET00	;GET THE PARAMETERS
	MOV	WORK,R1
	MOV	USR(R1),R1	;SET TO START OF USER AREA
	TST	R4		;IS SECOND PARAMETER PRESENT?
	BNE	DEL05		;YES
	MOV	R3,R4		;NO
DEL05:	MOV	R4,-(SP)	;R4=SECOND PARAMETER
	MOV	R3,-(SP)	;R3=FIRST PARAMETER
	BEQ	DEL02
DEL01:	JSR	PC,SRCH00	;FIND THE NEXT LINE
DEL03:	CMP	R1,R5		;ALL DONE?
	BHIS	DEL02		;YES
	MOV	WORK,R2		;GET THE
	MOVB	@R1,TMPLN(R2)	;LINE
	MOVB	1(R1),TMPLN+1(R2) ;NUMBER
	MOV	-(R2),R0	;INTO R0
	CMP	R0,@SP		;COMPARE LINE NUMBERS
	BLT	DEL01
	CMP	R0,2(SP)	;COMPARE WITH END OF LIST
	BGT	DEL02
	JSR	PC,SQU00	;DELETE ONE LINE
	BR	DEL03
DEL02:	CMP	(SP)+,(SP)+	;POP TWO WORDS FROM STACK
	BR	INIT00
DEL04:	JSR	PC,CLRU00	;CLEAR USER SPACE FIRST
	JSR	PC,FIND00	;FIND THE LINE NUMBER
	BNE	INIT03		;NO SUCH LINE
	JSR	PC,SQU00	;FOUND, DELETE IT
	BR	INIT03
;
; PDP-11 BASIC - COMMAND/STATEMENT INTERPRETER
;	REGISTERS USED - R0,R1,R2,R3,R4,R5
;
INIT02:	JSR	PC,NXTUSR	;GO SET UP NEXT JOB
	JSR	PC,SKIP00	;GET THE NEXT CHARACTER
	CMPB	#':,R2		;IS THIS A CONTINUATION?
	BEQ	INIT10		;JUMP IF YES
	CMPB	#12,R2		;IS IT A LINE FEED
	BEQ	INIT03		;JUMP IF YES
	ILCERR			;ILLEGAL CHARACTER TERMINATING STMT.
INIT03:	MOV	WORK,R0		;GET DATA AREA POINTER
	TST	RUNF(R0)	;IS RUN MODE SET
	BEQ	INIT04		;JUMP IF NOT
	TST	ENDTXT(R0)	;IS USER AREA SET UP?
	BEQ	INIT19		;NO, DO DIFFERENT TEST
	CMP	R1,ENDTXT(R0)	;IS THE TEXT POINTER TOO FAR ALONG?
	BR	INIT20
INIT19:	CMP	R1,R5
INIT20:	BHIS	STOP03		;JUMP IF YES
INIT13:	MOV	WORK,R2
	TST	-(R2)
	MOVB	(R1)+,(R2)+	;GET THE
	MOVB	(R1)+,(R2)+	;LINE NUMBER
	MOV	-(R2),R0	;IN TMPLN TO R0
	CLR	(R2)+		;THEN CLEAR THE POINTER
	MOV	R0,LINENO(R2)
INIT10:	JSR	PC,STAT		;GET STATUS ADDRESS
	BIT	#1,B.STUS(R0)	;CHECK ^C
	BNE	STOP03		; ^C WAS TYPED ONCE OR MORE
	JSR	PC,SKIP00	;GET VERB
	SUB	#140,R2		;GET ADDRESS DISPLACEMENT
	BMI	INIT09		;NOT LEGAL
	ASL	R2
	JMP	@INIT12(R2)	;GO DO IT
DEL06:	BR	DEL04
STOP03:	JMP	STOP00
RESTRT:	MOV	WORK,R1
	MOV	ENDUSR(R1),SP
	MOV	SLOT(R1),R5	;GET USER SLOT ADDRESS
	MOV	#4,R4		;GET COUNT OF SLOTS
RES001:	MOV	@R5,R0		;GET FIRST SLOT
	BEQ	RES002		;NOT USED
	MOV	IODEV(R1),R2	;GET USER TTY SLOT
	ASL	R2		;SHIFT IT
	CMP	R2,R0		;USER TTY?
	BEQ	RES004		;IF EQUAL, DON'T DETACK IT
	BIC	USRMSK(R1),ATTACH(R0) ;DETACH THE DEVICE
RES004:	CLR	(R5)		;CLEAR THE SLOT POINTER
RES002:	TST	(R5)+
	DEC	R4		;DECREMENT SLOT COUNT
	BGT	RES001		;LOOP UNTIL DONE
	CLR	HGHLN(R1)	;CLEAR THE HIGH LINE POINTER
	MOV	USR(R1),R5	;RESTART ENTRY - CLEAR USER AREA
	INC	R5		; AND FAKE A
	CLR	ENDTXT(R1)	;  CTRL P.
	MOVB	IODEV(R1),R1
	JSR	PC,INITI
INIT01:	MOV	WORK,R0
	MOV	ENDUSR(R0),SP	;ON ^P CLEAR A
	CLR	OLDF(R0)	; FEW
	JSR	PC,STAT		;    THINGS
	BIC	#11,B.STUS(R0)	;       (^C AND ^O FLAG TOO)
	MOV	WORK,R0
	CLR	LINENO(R0)	;CLEAR THE LINE NUMBER
	JSR	PC,CRLF00	;    AND NEATLY FINISH UP
INIT26:	MOV	WORK,R0
	CLR	SAVF(R0)	;CLEAR THE SAVE FLAG TOO
INIT00:	MOV	WORK,R0
	CLR	TMPLN(R0)		;CLEAR TMPLN
	CLR	RUNF(R0)	;CLEAR RUN FLAG TO START
	MOV	#RDY00,R0	;TELL USER THAT
	JSR	PC,PRN00	;ALL IS READY
INIT04:	JSR	PC,STAT		;GET FLAGS
	BIC	#11,B.STUS(R0)	; IS ^C SET??
INIT28:	BR	INIT07
INIT09:	UNRERR			;UNRECOGNIZED STATEMENT
INIT07:	CLR	R1
	JSR	PC,PCK00	;GET A COMMAND
	JSR	PC,SKIP00	;GET THE FIRST CHARACTER
	CMP	R2,#12		;IGNORE IF ONLY A TERMINATOR
	BEQ	INIT04
	DEC	R1		;BACK UP FOR LINE CHECK
	JSR	PC,ATOI00	;GET INTERNAL LINE NUMBER
	CMPB	@R1,#12		;CALL IT A DELETE IF NO
	BEQ	DEL06		; VERB WAS TYPED
	MOV	WORK,R2
	MOV	R0,-(R2)	;GET TMPLN
	TST	(R2)+
	MOV	R1,R3
INIT29:	MOVB	(R3)+,@R2	;SCRUNCH
	CMPB	(R2)+,#12	;OUT THE OLD
	BNE	INIT29		;LINE NUMBER
	MOV	WORK,R1
INIT05:	MOV	R1,R3		;SAVE THE TEXT POINTER
	MOV	#INIT11,R0	;GET ADDRESS OF PROTOTYPES
	CLR	R2		;CLEAR JUMP POINTER FLAG
INIT06:	CMPB	(R3)+,#' 	;IS CHARACTER A SPACE?
	BEQ	INIT06		;IGNORE SPACES
	CMPB	-(R3),(R0)+	;DOES CHARACTER MATCH PROTOTYPE
	BNE	INIT08		;NO
	INC	R3		;YES, GET NEXT CHARACTER
	CMPB	@R0,#'$		;IS NEXT CHARACTER THE TERMINATOR?
	BEQ	INIT14		;IF SO, EXIT SUCCESSFULLY
	BR	INIT06		;GO BACK
INIT08:	CMPB	(R0)+,#'$	;SKIP TO START OF NEXT
	BNE	INIT08		;  PROTOTYPE
	CMPB	@R0,#'$		;TWO IN A ROW?
	BEQ	INIT09		;YES, END OF LIST
	MOV	R1,R3		;RESET TEXT POINTER
	INC	R2		;INCREMENT JUMP POINTER
	BR	INIT06		;RE-LOOP
INIT14:	ADD	#140,R2		;GENERATE SPECIAL BYTE
	MOVB	R2,(R1)+	;STORE IT IN THE TEXT
	MOV	R1,R4		;REMEMBER PLACE IN LINE
INIT15:	MOVB	@R3,(R1)+	;PACK
	CMPB	(R3)+,#12	; LINE UP TIGHT
	BNE	INIT15
	CMPB	R2,#143		;IS IT A "REM"ARK?
	BEQ	INIT27		;QUIT IF IT IS
	CMP	R2,#155		;IS THIS LINE AN "IF"?
	BNE	INIT18		;NO, EXIT.
	MOV	R4,R1		;START SCAN FOR "THEN"
INIT16:	JSR	PC,SKIP00
	CMPB	R2,#'T		;IT STARTS WITH A "T"
	BNE	INIT17
	JSR	PC,SKIP00
	CMPB	R2,#'H		;FOLLOWED BY AN "H"
	BNE	INIT17
	JSR	PC,SKIP00
	CMPB	R2,#'E		;THEN AN "E"
	BNE	INIT17
	JSR	PC,SKIP00
	CMPB	R2,#'N		;FINALLY AN "N"
	BNE	INIT17		;GO BACK AND SCRUNCH IT TOO
INIT21:	JSR	PC,SKIP00	;MAKE LEADING BLANKS SAFE
	DEC	R1		;BEFORE MODIFYING STATEMENT
	MOV	R1,R4		;THIS KEEPS ME FROM AN INFINITE LOOP
	JSR	PC,TST00	;IF THE "THEN" IS FOLLOWED BY A
	BEQ	INIT18		;  NUMBER IT IS LEGAL
	BR	INIT05
INIT17:	CMPB	R2,#12		;END OF LINE?
	BEQ	INIT27		;NO
	CMPB	R2,#':		;ALTERNATE END OF LINE?
	BNE	INIT16		;NO
INIT18:	MOV	R4,R1		;RESET THE POINTER
INIT23:	CMPB	@R1,#'"		;IS CHARACTER START OF QUOTE STRING?
	BEQ	INIT24		;YES
	CMPB	(R1)+,#':	;NO, IS IT A STATEMENT SEPARATOR?
	BEQ	INIT21		;YES
	CMPB	-(R1),#12	;THEN IS IT A TERMINATOR?
	BEQ	INIT22		;YES
INIT25:	INC	R1		;NO
	BR	INIT23
INIT24:	INC	R1
	CMPB	@R1,#'"		;IS THIS THE SECOND "?
	BEQ	INIT25		;YES
	CMPB	@R1,#12		;NO, END OF LINE?
	BNE	INIT24		;NO
	UNMERR			;UNMATCHED QUOTES IN LINE
INIT22:	INC	R1
INIT27:	MOV	R1,R3		;SAVE END OF LINE POINTER
	MOV	WORK,R1	;YES, CONTINUE MAIN LOOP
	TST	-(R1)
	TST	(R1)+		;CHECK TMPLN
	BNE	ASSM00		;YES, GO ASSEMBLE LINE
	CLR	OLDF(R1)	;TURN OFFF OLD FLAG
	JMP	INIT10
;
; ASSEMBLE LINE OF CODE INTO WORKING STORAGE - TRANSFER TO USER AREA
;	REGISTERS USED - R0,R1,R2,R3,R4.
;
ASSM00:	JSR	PC,CLRU00	;CLEAR USER SPACE IF ANY
	MOV	WORK,R1	;GET STORAGE ADDRESS
	TST	-(R1)		;POINT TO LINE NUMBER
	SUB	R1,R3		;GET LINE LENGTH
	MOV	R3,-(SP)	;SAVE IT
	MOV	@R1,R0		;GET LINE NUMBER
	BEQ	ASSM02		;YES, DISALLOWED
	CMP	R0,#17777	;LINE NUMBER .GT. 8191?
	BGT	ASSM02	;YES, DISALLOWED
	CMP	R0,HGHLN+2(R1)	;CHECK FOR EASY INSERT!!
	BLE	ASSM04	;NOT EASY
	MOV	R0,HGHLN+2(R1)	;MAKE MORE DIFFICULT
	MOV	R5,R1		;POINT TOEASY SPOT
	BR	ASSM01
ASSM04:	JSR	PC,FIND00	;LOOK FOR LINE NUMBER IN TEXT
	BNE	ASSM01		;DON'T DELETE LINE
	JSR	PC,SQU00	;DELETE TEXT LINE TO TERMINATOR
ASSM01:	MOV	(SP)+,R3	;RESTORE LINE LENGTH
	MOV	R3,R0
	JSR	PC,TSTU00	;ENOUGH ROOM IN USER STORAGE?
	BHIS	INS01		;YES
	OVFERR			;OVERFLOW ERROR
INS04:	ADD	R0,R5		;UPDATE TEXT POINTER
INS05:	MOV	WORK,R2
	TST	-(R2)		;GET ADDRESS
	MOVB	(R2)+,(R1)+	;TRANSFER
	MOVB	(R2)+,(R1)+	;LINE NUMBER
INS03:	MOVB	@R2,(R1)+	;INSERT NEW TEXT
	CMPB	(R2)+,#12	;CHECK FOR LINE TERMINATOR
	BNE	INS03
	JMP	INIT03
INS01:	CMP	R1,R5		;IS POINTER AT END OF TEXT?
	BHIS	INS04		;JUMP IF YES
	MOV	R5,R2
	ADD	R0,R5		;MOVE STORAGE POINTER
	MOV	R5,R4
INS02:	MOVB	-(R2),-(R4)	;SHIFT THE TEXT AROUND
	CMP	R1,R2		;DONE?
	BLOS	INS02		;NO, DO IT AGAIN
	BR	INS05
ASSM02:	LNNERR			;BAD LINE NUMBER
;
INIT11:	.ASCII	/LIST$LET$READ$REM$RUN$RESTORE$/
	.ASCII	/RETURN$DATA$DIM$DELETE$PRINT$GOSUB$/
	.ASCII	/GOTO$IF$FOR$NEXT$INPUT$SAVE$STOP$END$DEF$/
	.ASCII	/OLD$RANDOMIZE$OPEN$CLOSE$$/
	.EVEN
;
INIT12:	LIST00		;LIST - 140
	LET00		;LET - 141
	READ00		;READ - 142
	REM00		;REMARK - 143
	RUN00		;RUN - 144
	RES00		;RESTORE - 145
	RET00		;RETURN - 146
	REM00		;DATA - HANDLE LIKE REMARK - 147
	DIM00		;DIM - 150
	DEL00		;DELETE - 151
	PR00		;PRINT - 152
	GOSB00		;GOSUB - 153
	GOTO00		;GOTO - 154
	IF00		;IF - 155
	FOR00		;FOR - 156
	NEXT00		;NEXT - 157
	INP00		;INPUT - 160
	SAVE00		;SAVE - 161
	STOP00		;STOP - 162
	STOP00		;END - 163
	DEF00		;DEFINE - 164
	OLD00		;OLD - 165
	RND01		;RANDOMIZE - 166
	OPEN		;OPEN - 167
	CLOSE		;CLOSE - 170
;
RDY00:	.ASCII	/READY/
RDY01:	.BYTE	15,12,0
	.EVEN
;
; OPEN A SLOT
;
OPEN:	JSR	PC,SKIP00		;GET A CHARACTER
	CMPB	R2,#'"		;IS IT A "??
	BNE	BADOPN
	CLR	R0		;SET HASH TO ZERO
	MOV	#3,R4		;SET CHARACTER COUNT TO THREE
OPEN1:	JSR	PC,SKIP00	;GET A CHARACTER
	JSR	PC,TST00	;IS IT ALPHABETIC?
	BVS	BADOPN		;NO
	BEQ	BADOPN		;NO
	BIC	#177700,R2	;YES, CLEAR ALL BUT SIX BITS
	ADD	R2,R0		;ADD ACCUMULATED CHARACTER
	DEC	R4		;DECREMENT COUNT
	BLE	OPEN2		;QUIT WHEN DONE
	JSR	PC,MLS00	;MULTIPLY BY
	JSR	PC,MLS00	;36
	BR	OPEN1
OPEN2:	MOV	#DEVNAM,R2	;WE NOW HAVE DEVICE NAME
OPEN3:	CMP	(R2)+,R0	;DOES IT MATCH?
	BEQ	OPEN4		;YES, EXIT
	CMP	R2,#DEVEND	;NO, CHECK TABLE LIMITS
	BLO	OPEN3		;YES, KEEP LOOKING
	DEVERR			;ILLEGAL DEVICE IN OPEN
OPEN4:	MOV	SLTPNT-DEVNAM-2(R2),R0 ;GET INTERNAL SLOT POINTER
	JSR	PC,TWO00	;GET TWO MORE CHARACTERS
	CMP	R4,#"":		;IS IT THE :" ??
	BNE	BADOPN		;NO
	JSR	PC,TWO00	;GET TWO MORE
	CMP	R4,#"SA		;MUST BE AS
	BNE	BADOPN
	JSR	PC,TWO00	;GET "FI"
	CMP	R4,#"IF		;CHECK FOR "FI"
	BNE	BADOPN		;NOT CORRECT
	JSR	PC,TWO00	;CHECK FOR "LE"
	CMP	R4,#"EL
	BNE	BADOPN
	TST	R0		;IS DEVICE USER TELETYPE?
	BMI	OPEN6		;SKIP TEST IF SO
	TST	ATTACH(R0)	;IS IT ALREADY ATTACHED?
	BNE	INUSEO	;YES
OPEN6:	MOV	R0,-(SP)	;REMEMBER THE DEVICE
	JSR	PC,EVAL00	;GET EXTERNAL SLOT NUMBER
	JSR	PC,FIX00	;MAKE IT USEABLE
	DEC	R0
	BMI	OPNER		;ILLEGAL SLOT IN OPEN
	CMP	R0,#3		;TOO BIG?
	BGT	OPNER		;YES
	ASL	R0
	MOV	WORK,R2		;GET THE
	MOV	SLOT(R2),R2	;ADDRESS OF THE SLOT TABLE
	ADD	R0,R2		;GET DESIRED ENTRY
	TST	@R2		;IS IT ALREADY IN USE?
	BNE	INUSE		;YES
	MOV	WORK,R4
	MOV	(SP)+,@R2	;NO, SET IT IN USE
	BPL	OPEN7
	MOV	IODEV(R4),@R2	;SET TELETYPE DEFAULT
	ASL	@R2		;CONVERT TO INTERNAL SLOT
	BR	OPNDON
OPEN7:	MOV	@R2,R3		;GET INTERNAL SLOT
	BIS	USRMSK(R4),ATTACH(R3) ;ATTACH THE UNIT
OPNDON:	JMP	INIT02
INUSEO:	BMI	BADOPN		;JUMP IF DEVICE NOT THERE
	MOV	WORK,R4
	BIT	USRMSK(R4),ATTACH(R0) ;IS IT MINE?
	BNE	INUSE1		;YES, I'VE ALREADY GOT IT
	OPNERR			;SOMEONE ELSE ALREADY IS OPEN
INUSE:	TST	(SP)+
INUSE1:	OP1ERR			;ALREADY OPEN
BADOPN:	NXDERR			;NON-EXISTENT DEVICE
OPNER:	SLTERR			;ILLEGAL SLOT
;
; CLOSE A SLOT
;
CLOSE:	JSR	PC,EVAL00	;GET EXTERNAL SLOT NUMBER
	JSR	PC,FIX00	;GET IT IN USEABLE FORM
	DEC	R0		;CONVERT IT TO A POINTER
	BMI	CLS01		;ILLEGAL CLOSE
	CMP	R0,#3		;IS IT TOO LARGE?
	BGT	CLS01		;YES
	ASL	R0
	MOV	WORK,R2		;GET THE
	MOV	SLOT(R2),R2	;GET ADDRESS OF SLOT TABLE
	ADD	R0,R2		;GET THE
	MOV	@R2,R3		;INTERNAL SLOT
	BEQ	CLS		;NOTHING TO DO, SO EXIT
	ASR	R3		;CONVERT TO SIMPLE SLOT FORM
	MOV	WORK,R0		;IS THIS THE
	CMP	IODEV(R0),R3	;USER'S OWN TELETYPE?
	BEQ	CLS03		;YES, ONLY CLEAR POINTER TO DEVICE
	ASL	R3		;CONVERT BACK TO INTERNAL FORM
	BIC	USRMSK(R0),ATTACH(R3) ;CLOSE THE UNIT
CLS03:	CLR	@R2		;CLEAR THE EXTERNAL POINTER
CLSDON:	JMP	INIT02	;NOW EXIT
CLS01:	CLSERR		;ILLEGAL CLOSE
CLS:	WCLERR			;WARNING - NO SLOT TO CLOSE
	BR	CLSDON
;
; STOP - STOP AND END STATEMENTS - TELL USER PROGRAM IS DONE
;	REGISTERS USED - R0,R1,R2,R3,R4
;
STOP00:	JSR	PC,STAT
	BIC	#11,B.STUS(R0)	;CLEAR ^C AND ^O
	JSR	PC,CRLF00
	MOV	#STOP01,R0	;TELL USER
	JSR	PC,PRN00	;  THAT ALL HAS STOPPED
	JSR	PC,PRLN00	;   AT SOME FUNNY PLACE
	JSR	PC,CRLF00	;AND THEN
STOP02:	MOV	WORK,R2
	CLR	LINENO(R2)
	JMP	INIT00		; ASK WHAT NEXT
STOP01:	.ASCII	/STOP AT LINE/

	.EOT			;END OF TAPE 5
	.BYTE	0
	.EVEN
;
; RUN - START PROGRAM EXECUTION
;	REGISTERS USED - R5
;
RUN00:	JSR	PC,CLRU00	;CLEAR ANY REMAINING USER AREA
	MOV	WORK,R2
	CLR	LINENO(R2)	;CLEAR LINE NUMBER POINTER
	MOV	USR(R2),R1	;PUT START OF USER AREA
	INC	R1		; PLUS ONE IN R1
	MOV	#13507,M.I(R2)	;RESET RANDOM NUMBER GENERATOR
	INC	RUNF(R2)	;TURN ON RUN FLAG
	JMP	INIT03		;GO BACK AND LOOK FOR LINE TO DO
;
; GOSB00 - GOSUB STATEMENT, PUSH CLASS 1 ITEM ON STACK THEN DO A GOTO
;	REGISTERS USED - R0,R1,R2,R3,R4
;
GOSB00:	MOV	WORK,R0
	MOV	LINENO(R0),R0	;GET CURRENT LINE NUMBER
	BIS	#020000,R0	;SET CLASS 1 FLAG
	JSR	PC,PUSH00	;PUSH ITEM ON STACK
;
; GOTO00 - GOTO STATEMENT - RESET LINENO TO NEW EXECUTION POINT
;	REGISTERS USED - R0,R1,R2,R3,R4
;
GOTO00:	JSR	PC,ATOI00	;ASCII FROM R1 LIST TO INTEGER IN R0
	JSR	PC,FIND00
	BNE	GOTO01		;LINE DOESN'T EXIST
GOTO02:	MOV	WORK,R2
	MOV	#1,RUNF(R2)	;SET THE RUN FLAG JUST IN CASE HE'S
				;TRYING TO START AGAIN
	JSR	PC,NXTUSR	;CHECK NEXT USER BEFORE CONTINUING
	JMP	INIT13
GOTO01:	GOERR			;ILLEGAL GOTO OR GOSUB
;
; RES00 - RESTORE STATEMENT - CLEAR THE DATA POINTER
;	REGISTERS USED - R0
;
RES00:	MOV	WORK,R0
	CLR	DATI(R0)
	BR	DIM05		;CLEAR DATA FLAG AND GO AWAY
;
; RET00 - RETURN STATEMENT - FIND LAST GOSUB ITEM IN LIST,
;	GET ITS LINE NUMBER, PLACE IN LINENO, AND DELETE THE ITEM.
;	REGISTERS USED - R0,R1,R2,R3,R4,R5
;
RET00:	CLR	-(SP)		;SET UP TEMPORARY POINTER
	MOV	#020000,R4	;LOOK FOR CLASS 1
	JSR	PC,TXT00	;GET ADDRESS OF LIST
	BEQ	RET03		;ERROR IF NO LIST
	MOV	#017777,R0	;SET SEARCH MASK
RET01:	JSR	PC,SRL00	;FIND A CLASS 1 ITEM
	BEQ	RET02		;JUMP IF DONE LOOKING
	MOV	R3,@SP		;SAVE LOCATION
	TST	(R3)+		;SKIP OVER CURRENT ONE
	BR	RET01		;LOOK AGAIN UNTIL LAST IS FOUND
RET02:	MOV	(SP)+,R3	;GET LAST ADDRESS
	BEQ	RET03		;ERROR
	MOV	@R3,R0		;GET ITEM
	BIC	R4,R0		;CLEAR OUT CLASS MARK
	INC	R0
	MOV	#2,R4		;SCRUNCH TWO BYTES
	JSR	PC,SCR00	;DELETE ITEM FROM USER AREA
	CMP	R0,#1		;IS THE RETURN TO LINE #1?
	BEQ	STOP02		;YES IT CAME FROM COMMAND MODE
	JSR	PC,FIND00
	BR	GOTO02
RET03:	RETERR
;
; DIM STATEMENT - GENERATE DIMENSIONED TABLE ENTRY
;	REGISTERS USED - R0,R1,R2,R3,R4.
;
DIM00:	JSR	PC,GTDR00	;GET A TRUNCATED VARIABLE
DIM01:	BVS	DIM99		;ERROR IF NG.
	BNE	DIM97		;PREVIOUSLY DECLARED VARIABLE FOUND
	MOV	R4,-(SP)
	JSR	PC,SKIP00	;GET NEXT CHARACTER
	CMP	R2,#'(		;IS IT A LEFT PAREN
	BNE	DIM99		;NO, ERROR
	JSR	PC,ATOI00	;YES, GET FIRST DIMENSION
	JSR	PC,DIMC00	;CHECK FOR DIMENSION WITHIN BOUNDS
	BNE	DIM99		;NOT IN BOUNDS
	MOV	R0,-(SP)	;PUT AWAY FIRST DIMENSION
	SWAB	@SP		;IN UPPER HALF WORD
	JSR	PC,SKIP00	;GET LAST CHARACTER SCANNED
	CMPB	R2,#',		;IS IT A COMMA?
	BNE	DIM03		;NO
	JSR	PC,ATOI00	;GET SECOND DIMENSION
	JSR	PC,DIMC00	;IS IT IN RANGE?
	BNE	DIM99		;NO
	BIS	R0,@SP		;YES, PACK IT IN
	JSR	PC,SKIP00	;GET A CHARACTER
DIM03:	CMP	R2,#')		;NO IS IT A RIGHT PAREN?
	BEQ	DIM04		;YES, GET NEXT CHARACTER
DIM99:	DIMERR			;BAD DIMENSION
DIM04:	MOV	(SP)+,R2	;GET PACKED DIMENSIONS
	MOV	(SP)+,R0	;GET HEADER
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	JSR	PC,PUSH00	;PUSH HEADER ON LIST
	MOV	#6,R0		;PUT AWAY
	JSR	PC,PUSH00	;CURRENT LENGTH
	MOV	R2,R0		;
	JSR	PC,PUSH00	;PUSH PACKED DIMENSIONS ON LIST
	MOV	R2,R1
	SWAB	R1		;GET FIRST DIMENSION AGAIN
	JSR	PC,ARYL00	;COMPUTE NUMBER OF ITEMS TO SKIP
	BVS	DIM98
	JSR	PC,TSTU00	;OVERFLOW?
	BLO	DIM98		;YES
	ADD	R0,-4(R5)	;CORRECT ACTUAL LENGTH
	ADD	R0,R5		;NO, UPDATE POITER
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	JSR	PC,SKIP00	;GET A CHARACTER
	CMP	R2,#',		;COMMA?
	BEQ	DIM00		;YES LOOK FOR NEXT ITEM
	DEC	R1		;BACK UP OVER TERMINATOR
DIM05:	JMP	INIT02		;NOW GOAWAY
DIM98:	DMVERR			;OVERFLOW
DIM97:	DMDERR			;PREVIOUSLY USED OR DECLARED
;
; DEFINE STATEMENTS ARE DONE HERE - ONE TABLE ENTRY IS MADE, CONFLICTS
;	ARE NOT CHECKED.  REGISTERS USED - R1,R2,R4.
;
DEF00:	JSR	PC,TWO00	;LOOK FOR "FN"
	CMP	R4,#"NF		;IS IT AN "FN"?
	BNE	DEF99		;NO, BAD STATEMENT
	JSR	PC,SKIP00	;GET FUNCTION NAME
	JSR	PC,TST00	;IS IT ALPHABETIC?
	BEQ	DEF99		;NO
	BVS	DEF99		;NO
	BIS	#060000,R2	;YES, SET CLASS TO 3
	MOV	R2,R0
	JSR	PC,PUSH00	;PUT AWAY THE HEADER
	JSR	PC,SKIP00
	CMP	R2,#'(		;IS THE REQUIRED LEFT PAREN PRESENT?
	BNE	DEF99		;NO
	JSR	PC,GETV00	;GET THE VARIABLE NAME
	BVS	DEF99		;ERROR IF BAD VARIABLE
	MOV	R4,R0
	JSR	PC,PUSH00	;PUT AWAY THE NAME IN WORD 2
	CMP	R2,#')		;CLOSING PAREN PRESENT?
	BNE	DEF99		;NO
	JSR	PC,SKIP00
	CMP	R2,#'=		;EQUAL SIGN?
	BNE	DEF99
	MOV	R1,R0
	JSR	PC,PUSH00	;PUT AWAY ADDRESS OF DEFINITION
	JSR	PC,JUNK00	;SKIP OVER REST OF DEFINITION
	BR	DIM05
DEF99:	DEFERR			;HORRIBLE ERROR!!!
;
; EVAL - EVAL00, EVALUATE AN ARITHMETIC EXPRESSION.  UPON ENTRY, R1
;	POINTS TO THE CURRENT TEXT POSITION.  ON EXIT, R2,R3, AND R4
;	CONTAIN THE NUMERIC VALUE OF THE EXPRESSION.  REGISTERS USED - ALL.
;
EVAL00:	CLR	R0
	JSR	PC,PUSH00	;CLEAR THE PAREN COUNT
	MOV	#-1,-(SP)	;PUSH NULL (-1) ON STACK
EVAL02:	JSR	PC,TSTU00	
	BLO	EVAL18
	JSR	PC,SKIP00	;GET A NON-BLANK CHARACTER
	CMP	R2,#'+		;IS THIS A UNARY PLUS?
	BEQ	EVAL03		;YES, IGNORE IT
	CMP	R2,#'-		;IS IT A UNARY MINUS?
	BNE	EVAL01		;NO
	MOV	R2,R0		;YES, SET OPERAND2=0
	CLR	R2		;AND PUT THE
	CLR	R3		; OPERATOR IN R0
	CLR	R4
EVAL05:	JSR	PC,MOVS00	;PUSH OPERAND ON STACK
	MOV	R0,-(SP)	;  OPERATOR TO STACK
EVAL03:	JSR	PC,SKIP00	;GET ACHARACTER
EVAL01:	CMP	R2,#'(		;IS OPERAND AN OPEN PAREN?
	BNE	EVAL04		;NO, GET A REAL OPERAND
	CLR	-(SP)		;PUSH A NULL ON THE STACK
	INC	-2(R5)		;INCREMENT THE PAREN COUNT
	BR	EVAL02		;GO BACK AND DO IT AGAIN
GTPR02:	MOV	R2,R0		;PUT A CHARACTER IN R0
	BR	GTPR03
EVAL04:	DEC	R1		;MOVE CHARACTER POINTER BACK ONE
	MOV	-(R5),-(SP)	;SAVE PAREN COUNT
	JSR	PC,GTP00	;GET AN OPERAND
	MOV	(SP)+,(R5)+	;RESTORE THE PAREN COUNT
EVAL12:	MOV	R2,-(SP)	;SAVE R2
	JSR	PC,SKIP00	;GET A CHARACTER
	MOV	#EVAL07+7,R0	;GET ADDRESS OF LIST
GTPR01:	CMPB	-(R0),R2	;IS IT A LEGAL OPERATOR?
	BEQ	GTPR02		;JUMP IF LEGAL
	CMP	R0,#EVAL07+1	;HAS SEARCH FAILED?
	BHI	GTPR01		;NO
	CLR	R0		;YES - SET ZERO AND BACK UP POINTER
	DEC	R1		; TO POINT AT FAILURE
GTPR03:	MOV	(SP)+,R2	;RESTORE R2
	TST	@SP		;IS STACK NULL?
	BLE	EVAL17
EVAL06:	MOV	R1,-(SP)	;SAVE THE TEXT POINTER
	MOV	#EVAL07+7,R1	;GET THE TABLE ADDRESS
EVAL08:	CMPB	-(R1),R0		;FIND OPERATOR2
	BNE	EVAL08		;IT MUST BE FOUND
	ASR	R1		;GET RID OF THE BYTE POINTER
	MOV	R1,(R5)+	;PUT RESULT ON USER LIST FOR A WHILE
	MOV	#EVAL07+7,R1	;GET TABLE ADDRESS AGAIN
EVAL09:	CMPB	-(R1),2(SP)	;FIND OPERATOR1
	BNE	EVAL09		;IT MUST BE THERE
	ASR	R1		;CLEAR LOW ORDER BIT
	MOV	R1,(R5)+	;SAVE IT FOR NOW
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	CMP	-(R5),-(R5)	;COMPARE OPERATOR1 WITH OPERATOR2
	BLT	EVAL05		;GO BACK IF PRECEDENCE IS WRONG
	MOV	R0,(R5)+	;SAVE OPERATOR2 FOR NOW
	MOV	#EVAL07+7,R0
EVAL10:	CMPB	-(R0),@SP	;FIND APPROPRIATE OPERATOR IN LIST
	BNE	EVAL10		;IT MUST BE FOUND
	SUB	#EVAL07+2,R0	;GET DISPLACEMENT
	ASL	R0
	ADD	#EVAL11,R0	;WE NOW HAVE THE ROUTINE ADDRESS
	MOV	R0,(R5)+	;SAVE IT
	TST	(SP)+		;DISCARD OLD OPERATOR1
	MOV	SP,R0		;GET DESTINATION ADDRESS
	JSR	PC,MOVS00	;PUT SOURCE ON THE STACK
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	MOV	SP,R1		;GET
	TST	(R1)+		;SOURCE ADDRESS
	MOV	-(R5),R2	;ROUTINE ADDRESS
	MOV	-(R5),-(SP)	;SAVE OPERATOR2
	JSR	PC,@(R2)		;GO COMPUTE VALUE
	MOV	(SP)+,R0	;RESTORE OPERATOR2
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	ADD	#6,SP		;DISCARD SOURCE
	MOV	(SP)+,R2	;PLACE RESULT
	MOV	(SP)+,R3	; IN
	MOV	(SP)+,R4	;  OPERAND2
	TST	@SP		;IS STACK NULL?
	BGT	EVAL06		;NO, TAKE CARE OF REST OF STACK
EVAL17:	CMP	R0,#')		;IS OPERATOR2 A CLOSED PAREN?
	BEQ	EVAL14		;YES
	TST	R0		;NO, IS IT NULL?
	BGT	EVAL05		;NOT NULL - GO BACK
	TST	-(R5)		;IS THE PAREN COUNT ZERO?
	BNE	EVAL13		;NO
	TST	(SP)+		;POP NULL
	CCC
	RTS	PC		;RETURN WITH RESULT IN R2,R3,R4.
EVAL13:	PARERR			;PAREN COUNT BAD
EVAL14:	TST	-(R5)		;IS PAREN COUNT ZERO?
	BNE	EVAL15		;NO
EVAL16:	TST	(SP)+		;POP NULL
	SEV			;YES, ERROR - BUT DON'T TELL USER YET
	RTS	PC
EVAL15:	TST	@SP		;JUMP
	BLT	EVAL16		;IF NULL = -1
	TST	(SP)+		;POP NULL
	DEC	(R5)+		;DECREMENT PAREN COUNT
	BR	EVAL12		;AND DO IT AGAIN
	.EOT			;END OF TAPE 6
EVAL18:	OVFERR
EVAL07:	.BYTE	0,')		;DO NOT
	.BYTE	'+,'-		; CHANGE
	.BYTE	'*,'/		;  THE ORDER
	.BYTE	'^		;   OF THIS TABLE
	.EVEN
EVAL11:	ADDF00			;THIS
	SUBF00			; TABLE
	MULF00			;  PARALLELS THE ONE
	DIVF00			;   ABOVE, SO DO NOT
	PWRF00			;    CHANGE ITS ORDER
;
; GETOP - GTP00, GET AN OPERAND. 
;	UPON ENTRY, R1 POINTS TO THE START OF
;	AN OPERAND.  UPON EXIT, R2,R3,AND R4 CONTAIN THE VALUE OF THE
;	OPERAND IF LEGAL.  IF NOT LEGAL, A FATAL ERROR CALL IS MADE.  ON
;	LEGAL OR ILLEGAL EXITS, R1 WILL ALWAYS POINT ONE CHARACTER AFTER
;	THE SCAN WAS ENDED.  NOTE:  THIS ROUTINE MUST BE RE-ENTRANT,
;	SINCE IT MAY, BY WAY OF CALLS TO "EVAL", RE-ENTER
;	ITSELF BEFORE COMPLETION.  REGISTERS USED - ALL.
;
GTP06:	ILFERR
GTP00:	MOV	R1,-(SP)	;SAVE TEXT BACKUP POINTER
	JSR	PC,SKIP00	;GET FIRST CHARACTER
	JSR	PC,TST00
	BVS	GTP15		;JUMP IF BAD OPERAND
	BNE	GTP02		;JUMP IF NOT NUMERIC
GTP18:	MOV	(SP)+,R1	;RESTORE CHARACTER POINTER
	SUB	#6,SP		;RESERVE SOME SPACE
	MOV	SP,R0		;  FOR THE DESTINATION
	JSR	PC,ATOF00	;CONVERT THE NUMBER, IGNORING ERROR FLAGS
	BVS	GTP06
	MOV	(SP)+,R2	;GET
	MOV	(SP)+,R3	; THE
	MOV	(SP)+,R4	;  RESULT
	RTS	PC
GTP15:	CMP	R2,#'.		;DOES THE NUMBER START WITH "."?
	BEQ	GTP18		;YES
	BR	GTP19		;NO
GTP02:	CMP	R2,#'F		;IS THIS A "DEF"INED FUNCTION?
	BEQ	GTP07		;YES - SINCE NO STANDARD FUNCTION BEGINS WITH "F"
	MOV	#177700,-(SP)
	BIC	@SP,R2		;MASK OFF EXTRA BITS
	MOV	R2,R0
	JSR	PC,MLS00	;MULTIPLY
	JSR	PC,MLS00	; BY 36 HERE
	JSR	PC,SKIP00	;GET SECOND CHAR HERE
	JSR	PC,TST00
	BVS	GTP11		;GO TRY FOR A VARIABLE
	BEQ	GTP11		;IF NOT A FUNCTION
	BIC	@SP,R2		;MAKE 8 BITS INTO 6
	ADD	R2,R0		;ADD IT IN MODULO 36
	JSR	PC,MLS00	;MULTIPLY BY
	JSR	PC,MLS00	; 36 AGAIN
	JSR	PC,SKIP00	;GET THIRD CHARACTER
	JSR	PC,TST00	;CHECK WHAT IT IS
	BVS	GTP11		;TRY FOR A
	BEQ	GTP11		;VARIABLE IF NOT A FUNCTION
	BIC	(SP)+,R2
	ADD	R2,R0		;THIS IS THE FUNCTION NAME MOD 36
	MOV	#GTP16,R3	;START OF LIST
GTP04:	CMP	(R3)+,R0	;IS THIS A GOOD FUNCTION NAME?
	BEQ	GTP05		;YES
	CMP	R3,#GTP17	;SEARCH FAILURE?
	BLO	GTP04		;NO
	BR	GTP19		;YES, GO TRY A VARIABLE
GTP05:	JSR	PC,SKIP00
	CMP	R2,#'(		;IS THIS FUNCTION LEGAL?
	BNE	GTP09		;NO, GO TRY FOR AVARIABLE
	MOV	GTP17-GTP16-2(R3),-(SP)	;SAVE ADDRESS OF FUNCTION
	JSR	PC,EVAL00
	BVC	GTP21		;THERE MUST BE A PAREN FOUND
	MOV	(SP)+,R0	;RESTORE JUMP ADDRESS
	JSR	PC,MOVS00			;PUT AWAY VALUE
	MOV	R0,R2
	MOV	SP,R0		;SOURCE ADDRESS
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	MOV	R0,R1
	SUB	#6,SP
	MOV	SP,R0		;DESTINATION ADDRESS
	JSR	PC,@R2		;GO DO THE FUNCTION
	MOV	(SP)+,R2	;GET
	MOV	(SP)+,R3	; THE
	MOV	(SP)+,R4	;  VALUE
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	ADD	#10,SP		;GET RID OF ALL THE JUNK
	RTS	PC
GTP11:	TST	(SP)+		;POP MASK FROM STACK
GTP19:	BR	GTP09
GTP07:	JSR	PC,SKIP00	;GET SECOND CHARACTER
	CMP	R2,#'N		;LOOK FOR AN "N"
	BNE	GTP09		;GO FOR AVARIABLE IF SOMETHING ELSE
	JSR	PC,SKIP00	;GET THIRD CHARACTER
	JSR	PC,TST00
	BVS	GTP09		;IF NOT ALPHABETIC THEN
	BEQ	GTP09		;  GO TRY FOR A VARIABLE
	JSR	PC,TXT00	;GET ADDRESS OF USER STORAGE
	BEQ	GTP12		;ERROR IF NO USER LIST
	CLR	R0		;SET ZERO MASK FOR THE SEARCH
	BIS	#060000,R2	;SET CLASS 3
	MOV	R2,R4		; WITH FUNCTION NAME TO FIND
	JSR	PC,SRL00	;SEARCH THE LIST FOR THE ITEM
	BEQ	GTP09		;JUMP IF FAILURE, NOW TRY A VARIABLE
	TST	(R3)+
	MOV	(R3)+,R4	;GET NAME OF FORMAL PARAMETER
	MOV	(R3)+,-(SP)	;SAVE ADDRESS OF FUNCTION DEFINITION
	JSR	PC,TXT00	;GET BEGINNING OF LIST AGAIN
	JSR	PC,SRL00	;SEARCH LIST FOR THE VARIABLE
	BNE	GTP08		;JUMP IF FOUND
	JSR	PC,SKIP00
	CMP	R2,#'(
	BNE	GTP11		;JUMP IF BADNESS
	MOV	R4,-(SP)	;SAVE NAME OF FORMAL PARAMETER
	JSR	PC,EVAL00	;EVALUATE ACTUAL PARAMETER
	BVS	GTP20		;CLOSED PAREN MUST BE PRESENT HERE
GTP21:	PARERR
GTP20:	MOV	(SP)+,R0
	MOV	R5,-(SP)
	JSR	PC,PUSH00	;PUT AWAY
	MOV	#14,R0
	JSR	PC,PUSH00	;LENGTH
	CLR	R0		;THE
	JSR	PC,PUSH00	;VALUE
	JSR	PC,PUT00	;FOR THE FORMAL PARAMETER HERE
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	MOV	4(SP),R1	;TEMPORARY POSITION
	JSR	PC,EVAL00	;EVALUATE THE FUNCTION
	BVS	GTP21		;NO EXTRA PARENS ALLOWED HERE
	MOV	(SP)+,R1	;TEXT POINTER TO R0
	MOV	(SP)+,R5	;ADDRESS OF DUMMY TO R5 - DELETE F.P.
	CMP	(SP)+,(SP)+	;POP DEF'N ADDRESS AND REMEMBER CHAR. POINTER
	RTS	PC
GTP08:	ADD	#6,R3		;FOUND VARIABLE - POINT TO VALUE
	MOV	(SP)+,R0	;GET ADDRESS OF PROTOTYPE CODE
	MOV	(R3)+,-(SP)	;SAVE
	MOV	(R3)+,-(SP)	;THE REAL
	MOV	(R3)+,-(SP)	; VALUE
	MOV	R3,-(SP)	;AND THE ADDRESS
	MOV	R0,-(SP)	;AND THE PROTOTYPE POINTER
	JSR	PC,SKIP00
	CMP	R2,#'(		;IS IT LEGAL?
	BNE	GTP13		;NO
	JSR	PC,EVAL00	;GET VALUE OF REAL PARAMETER
	BVC	GTP21		;CLOSED PAREN MUST BE PRESENT
	MOV	R1,R0		;SAVE TEXT POINTER
	MOV	2(SP),R1	;GET ADDRESS OF VARIABLE
	MOV	R4,-(R1)	;PUT AWAY
	MOV	R3,-(R1)	; PARAMETER
	MOV	R2,-(R1)	;  THERE
	MOV	(SP)+,R1	;GET PROTOTYPE TEXT
	MOV	R0,-(SP)	;SAVE TEXT POINTER ON STACK
	JSR	PC,EVAL00	;EVALUATE FUNCTION
	BVS	GTP21		;NO EXTRA PARENS ALLOWED HERE
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	MOV	(SP)+,R0	;GET VARIABLE ADDRESS
	MOV	(SP)+,-(R0)	;PUT
	MOV	(SP)+,-(R0)	; REAL
	MOV	(SP)+,-(R0)	;  VARIABLE BACK WHERE IT BELONGS
	TST	(SP)+		;DISCARD OLD TEXT POINTER
	RTS	PC		;AND RETURN
GTP13:	ADD	#12,SP		;GET RID OF JUNK ON STACK
GTP09:	MOV	(SP)+,R1	;VARIABLE, BACK UP POINTER TO TRY AGAIN
	JSR	PC,GTDR00	;GET ADDRESS OF VARIABLE
	BVS	GTP12		;NON-EXISTENT
	BEQ	GTP12		; VARIABLE HERE
	MOV	(R0)+,R2
	MOV	(R0)+,R3
	MOV	(R0)+,R4
	RTS	PC
GTP12:	NXVERR			;NON-EXISTENT VARIABLE ERROR - ZERO ASSUMED
	CLR	R2		;SET
	CLR	R3		;VARIABLE
	CLR	R4		;TO ZERO
	RTS	PC
;
GTP16:	.WORD	60602	;SIN
	.WORD	10537	;COS
	.WORD	03756	;ATN
	.WORD	16300	;EXP
	.WORD	37343	;LOG
	.WORD	02553	;ABS
	.WORD	61246	;SQR
	.WORD	27634	;INT
	.WORD	56434	;RND
	.WORD	60472	;SGN
GTP17:	SINE00
	COS00
	ATN00
	EXPF00
	LOG00
	ABS00
	SQRT00
	INT00
	RND00
	SGN00
;
; GETADR - GTDR00, GET ADDRESS OF VARIABLE/ARRAY ELEMENT - DATA
;	ADDRESS RETURNED IN R0.  REGISTERS USED - R0,R1,R2,R3,R4.
;
GTDR00:	JSR	PC,GETV00	;GET A VARIABLE NAME
	BVS	GTDR03		;EXIT IF IN ERROR
	DEC	R1		;BACK UP CHARACTER POINTER
	CLR	R0		;SET ZERO SEARCH MASK
	JSR	PC,TXT00	;GET ADDRESS OF USER STORAGE
	BEQ	GTDR02		;JUMP IF NOT FOUND
	JSR	PC,SRL00			;FIND THE ITEM
	BEQ	GTDR02		;JUMP IF NOT THERE
	CMP	@SP,#DIM01	;SKIP THE REST IF
	BEQ	GTDR04		;   CALLED FROM DIM
	CMP	(R3)+,(R3)+		;POINT TO SUBSCRIPTS
	CMPB	@R1,#'(		;IS THERE A SUBSCRIPT EXPRESSION?
	BNE	GTDR01		;NO
	INC	R1		;SKIP OVER OPEN PAREN
	MOV	R4,-(SP)	;SAVE SEARCH OBJECT
	JSR	PC,SUBS00	;COMPUTE THE SUBSCRIPT
	MOV	(SP)+,R4
GTDR02:	TST	R0		;SET FLAGS
GTDR03:	RTS	PC		;RETURN WHEN DONE
GTDR01:	TST	(R3)+		;POINT TO DATA ADDRESS
GTDR04:	MOV	R3,R0		;PUT RESULT IN R0
	RTS	PC		;AND RETURN
;
; LET00 - LET STATEMENT, EVALUATE EXPRESSION AND ASSIGN A VALUE TO A
;	VARIABLE.  REGISTERS USED - ALL.
;
LET00:	JSR	PC,GTDR00	;GET VARIABLE ADDRESS
	BVS	LET99		;JUMP IF BAD VARIABLE
	BNE	LET01
	MOV	R4,R0		;GET NAME
	JSR	PC,PSH00	;PUSH VARIABLE ON THE LIST
LET01:	MOV	R0,-(SP)	;SAVE DATA ADDRESS
	JSR	PC,SKIP00
	CMP	R2,#'=		;IS THE "LET" OK?
	BNE	LET99		;NO
	JSR	PC,EVAL00	;YES, EVALUATE EXPRESSION
	BVS	LET98		;ERROR IF MISMATCHED PARENS
	MOV	(SP)+,R0	;GET DATA ADDRESS
	MOV	R2,(R0)+	;PUT
	MOV	R3,(R0)+	; RESULT
	MOV	R4,(R0)+	;  AWAY
	BR	IF11		;GO BACK FOR NEXT LINE
LET99:	LETERR			;ILLEGAL LET STATEMENT
LET98:	PARERR			;MISMATCHED PARENS
;
; IF <EXPRESSION><REL-OP><EXPRESSION> THEN <STMT>.  COMPARE TWO
;	EXPRESSIONS AND ACT ACCORDINGLY.  REGISTERS USED - ALL.
;
IF00:	CMP	-(SP),-(SP)		;RESERVE TWO PLACES
	JSR	PC,EVAL00	;EVALUATE THE FIRST PART OF THE STATEMENT
	BVS	LET98		;ILLEGAL PAREN
	JSR	PC,MOVS00	;PUT RESULT ON THE STACK
	JSR	PC,TWO00	;GET THE REL-OP HERE
	CMP	R2,#'>		;IS IT LEGAL?
	BEQ	IF01		;YES
	CMP	R2,#'=
	BEQ	IF01		;YES
	DEC	R1		;NO, BACK UP TEXT POINTER
	CLRB	R4		;CLEAR ILLEGAL CHARACTER
IF01:	MOV	#IF03,R2	;GET LIST OF LEGAL FORMS
IF02:	CMP	R4,(R2)+	;IS IT LEGAL?
	BEQ	IF05		;YES
	CMP	R2,#IF04	;DID SEARCH FAIL?
	BLO	IF02		;NO
	OPRERR			;YES - FATAL ERROR
IF05:	ADD	#-IF03-2,R2	;GET ADDRESS
	ASL	R2		;OF THE
	ADD	#IF04,R2	;REQUIRED TEST
	MOV	R2,6(SP)	;AND SAVE IT
	JSR	PC,EVAL00	;GET NEXT PART OF EXPRESSION
	BVS	LET98		;ILLEGAL PAREN
	MOV	R1,10(SP)	;SAVE TEXT POINTER
	JSR	PC,MOVS00	;PUT DESTINATION ON STACK
	JSR	PC,CMPF00	;COMPARE FLOATING
	JMP	@6(SP)		;DO RESULTING TEST
IF03:	.WORD	"><		; .NE.
	.WORD	"=<		; .LE.
	.BYTE	0,'<		; .LT.
	.WORD	"=>		; .GE.
	.BYTE	0,'>		; .GT.
	.BYTE	0,'=		; .EQ.
IF04:	BNE	IF07		;  .NE.
	BR	IF06
	BLE	IF07		;  .LE.
	BR	IF06
	BLT	IF07		;  .LT.
	BR	IF06
	BGE	IF07		;  .GE.
	BR	IF06
	BGT	IF07		;  .GT.
	BR	IF06
	BEQ	IF07		;  .EQ.
IF06:	ADD	#10,SP		;POP DESTINATION
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
REM00:	JSR	PC,SRCH00	;SKIP OVER REST OF LINE
	DEC	R1		;AND BACK UP THE POINTER
IF11:	JMP	INIT02		;AND GO AWAY (HANDLE REMARK HERE TOO)
IF07:	ADD	#10,SP		;POP DESTINATION
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	JSR	PC,TWO00	;GET TWO CHARACTERS
	CMP	R4,#"HT		;IS THIS A "THEN"?
	BNE	IF09		;NO
	JSR	PC,TWO00
	CMP	R4,#"NE		;MAKE SURE SPELLING IS OK
	BNE	IF99		;BAD IF STATEMENT
	JSR	PC,SKIP00	;SKIP OVER BLANKS
	DEC	R1		;POINT AT CHARACTER
	JSR	PC,TST00	;CHECK NUMERIC
	BVS	IF08		;MUST BE A CODE .GT. 140
	BNE	IF99		;ERROR IF ALPHABETIC
IF10:	JMP	GOTO00		;MAKE IT A GO TO
IF08:	JMP	INIT10		;GO BACK TO FIGURE OUT THE REST
IF09:	CMP	R4,#"OG		;IS THIS A "GO"?
	BNE	IF99		;NO, ERROR
	JSR	PC,TWO00
	CMP	R4,#"OT		;ERROR
	BEQ	IF10		; IF NOT A "GOTO"
IF99:	IFERR			;ILLEGAL IF

	.EOT			;END OF TAPE 7
;
;	PR00 - PRINT STATEMENT
;
;		REGISTERS USED 0,1,2,3,4-OR ALL FOR SHORT
;
PR00:	CLR	-(SP)		;A SWITCH TO FORCE A DELIMITER
	JSR	PC,SKIP00	;GET THE NEXT CHARACTER
	CMPB	R2,#'#		;IS THIS A DEVICE SPECIFICATION?
	BNE	PR16		;NO
	JSR	PC,EVAL00	;GET
	JSR	PC,FIX00	;DEVICE NUMBER
	JSR	PC,SKIP00
	CMPB	R2,#',		;MUST BE FOLLOWED BY A COMMA
	BEQ	PR18
	CMP	R2,#12		;TERMINATOR???
	BNE	PR22
	DEC	R1
PR18:	MOV	WORK,R2
	MOV	R0,SAVF(R2)
	BR	PR01
PR16:	DEC	R1
PR01:	JSR	PC,SKIP00
	MOV	#34,R0		;MAKE SURE SPACE IS AVAILABLE
	JSR	PC,TSTU00	;FIND OUT FOR SURE
	BLO	PR02A		;JUMP IF NOT
	CMPB	R2,#',		;CHECK FOR A VALID DELIMITER
	BEQ	PR04		;IS IT A COMMA?
	CMPB	R2,#';
	BEQ	PR09A		;IS IT A SEMI-COLON?
	CMPB	R2,#'"
	BEQ	PR12A		;IS IS A QUOTE?
	CMPB	R2,#':
	BEQ	PR13A		;IS IT A COLON?
	CMPB	R2,#012
	BEQ	PR13A		;IS IT A <LF>?
	TST	(SP)		;IT'S NOT A DELIMITER
	BLT	PR22		;IF NEGATIVE THEN WE WANTED ONE!
	DEC	R1		;BACK UP TO THE START OF THE EXPRESSION
	MOV	R1,-(SP)	;SAVE WHERE WE ARE
	JSR	PC,TWO00	;GET TWO CHARACTERS
	CMP	R4,#"HC		;SEE IF THE START OF CHR#(
	BEQ	PR20		;BRANCH IF MAYBE
	CMP	R4,#"AT		;SEE IF TAB(
	BEQ	PR30		;BRANCH IF YES
	CMP	R4,#"PS		;OR LAST AND LEASE SPACE(
	BNE	PR60		;EXIT IF AN EXPRESSION
	JSR	PC,TWO00	;GET 2 MORE
	CMP	R4,#"CA		;SEE IF SPAC
	BNE	PR22		;EXIT IF ERROR
	JSR	PC,TWO00	;GET 2 MORE
	CMP	R4,#"(E		;SEE IF SPACE(
	BNE	PR22		;EXIT IF ERROR
PR25:	JSR	PC,EVAL00	;EVALUATE
	BVC	PR22		;ERROR IF NO RIGHT PAREN
	JSR	PC,FIX00	;FIX
	TST	(SP)+		;REMOVE SAVED R1
	JMP	PR07		;GO LIKE COMMA
PR22:	PRNERR
PR20:	TST	(SP)+
	JSR	PC,TWO00	;GET 2 CHARACTERS
	CMP	R4,#"$R		;SEE IF CHR$
	BNE	PR22		;EXIT IF NOT
	JSR	PC,SKIP00	;GET NEXT ONE
	CMPB	R2,#'(		;SHOULD BE CHR$(
	BNE	PR22		;EXIT IF NOT
	JSR	PC,EVAL00	;EVALUATE
	BVC	PR22		;ERROR IF NO CLOSING PAREN
	JSR	PC,FIX00	;MAKE INTEGER
	MOV	R0,R2		;ELSE OUTPUT THE
	JSR	PC,PRNT00	;SPECIAL CHARACTER
	BR	PR09		;AND RESUME
PR30:	TST	(SP)+
	JSR	PC,TWO00	;GET 2 CHARACTERS
	CMP	R4,#"(B		;SHOULD BE TAB(
	BNE	PR22		;EXIT IF NOT
	JSR	PC,EVAL00	;EVALUATE
	BVC	PR22
	JSR	PC,FIX00	;MAKE ONE WORD
	MOV	WORK,R2
	MOV	SAVF(R2),R3	;GET OUTPUT SLOT NUMBER
	BEQ	PR33
	ASL	R3		;CONVERT TO INTERNAL SLOT
	MOV	SLOT(R2),R2	;GET POINTER TO EXTERNAL SLOT TABLE
	ADD	R2,R3		;GET INTERNAL
	MOV	@R3,R2		; SLOT EQUIVALENT
	BR	PR31
PR33:	MOVB	IODEV(R2),R2	;ELSE GET DDFAULT
	ASL	R2		;MAKE INTO AN INDEX
PR31:	MOV	POS(R2),R2	;GET POSITION INDICATOR
	CMP	R0,R2		;SEE IF THIS LINE OR NEXT
	BLT	PR32		;BRANCH IF NEXT LINE
	SUB	R2,R0		;CALC HOW MANY
	BR	PR07		;AND GO THERE
PR32:	MOV	R0,R3		;MOVE POS TO SAFE REG
	JSR	PC,CRLF00	;NEXT LINE
	MOV	R3,R0		;GET POS BACK
	BR	PR07		;AND MOVE OVER
PR01A:	BR	PR01
PR02A:	BR	PR02
PR09A:	BR	PR09
PR12A:	BR	PR12
PR13A:	BR	PR13
PR60:	MOV	(SP)+,R1	;RESTORE R1 MUST BE EXPRESSION
	JSR	PC,EVAL00	;GO FIND THE VALUE
	BVS	PR11		;OVERFLOW IS AN ERROR
	MOV	R1,-(SP)	;SAVE THE TEXT POINTER
	JSR	PC,FTOA00
	MOV	SP,R0		;THE OUTPUT AREA WAS LEFT ON THE STACK
	JSR	PC,PRN00
	ADD	#24,SP		;REMOVE THE OUTPUT AREA
	MOV	(SP)+,R1	;RESTORE THE TEXT POINTER
	MOV	#-1,(SP)	;FORCE A DELIMITER
	BR	PR01A

PR04:	MOV	WORK,R0
	MOV	SAVF(R0),R0
	BNE	PR04A
	MOV	WORK,R0
	MOVB	IODEV(R0),R0
PR04A:	ASL	R0
	MOV	POS(R0),R0	;GET THE POSITION
	CMP	R0,#56.		;WE'VE FOUND A COMMA
	BLT	PR05		;SEE IF THERE'S ANY MORE ROOM
	JSR	PC,CRLF00
	BR	PR09
PR05:	NEG	R0		;CALCULATE THE MOD 14 COUNT
PR06:	BGT	PR07		;ADD 14 UNTIL A POSITIVE RESULT
	ADD	#14.,R0		;ADD AND GO AGAIN
	BR	PR06
PR07:	MOVB	#040,R2		;OUTPUT SPACES
PR08:	JSR	PC,PRNT00
	DEC	R0		;DECREMENT THE MOD 14 COUNTER
	BGT	PR08		;LOOP IF MORE TO DO
PR09:	MOV	#1,(SP)	;SET DELIMITER FOUND SWITCH
	BR	PR01A

PR11:	PRNERR			;ISSUE FATAL ERROR

PR12:	MOVB	(R1)+,R2	;START TO OUTPUT THE LITERAL STRING
	JSR	PC,PRNT00
	CMPB	@R1,#012	;TRY TO FIND THE OTHER END OF THIS MESS
	BEQ	PR11		;LINE FEED BEFORE MATCHING " IS AN ERROR
	CMPB	@R1,#'"
	BNE	PR12		;IF NOT <LF> OR " GO AGAIN
	INC	R1		;SKIP THE "
	CLR	@SP		;SHOW A QUOTE FIELD EXISTS
	BR	PR01A

PR13:	TST	(SP)+		;CHECK FOR TRAILING DELIMITER
	BGT	PR14		;NEGATIVE OR ZERO MEANS CRLF
	JSR	PC,CRLF00
PR14:	DEC	R1		;BACK UP TO THE TERMINATOR
PR15:	MOV	WORK,R2
	CLR	SAVF(R2)	;RESET DEVICE TO TTY
	JMP	IF11		;BACK TO THE INTERPRETER
PR02:	OVFERR			;STORAGE OVERFLOW IN PRINT
INP00:	JSR	PC,SKIP00	;CHECK FOR DEVICE
	CMP	R2,#'#		;IS IT SPECIFIED?
	BNE	INP01		;NO
	JSR	PC,EVAL00	;YES, GET
	JSR	PC,FIX00	;SLOT NUMBER
	MOV	WORK,R2
	MOV	R0,INDEV(R2)
	JSR	PC,SKIP00	;LOOK FOR COMMA OR <LF>
	CMP	R2,#',		;COMMA?
	BEQ	INP03		;YES
	CMP	R2,#12		;<LF>
	BNE	INP07		;NOT EITHER
	BR	INP03
INP01:	MOV	WORK,R2
	CLR	INDEV(R2)
	DEC	R1		;BACK UP POINTER
INP03:	CLR	-(SP)		;SET UP A LAND MARK
	JSR	PC,COM00	;GET VARIABLE
	BVC	INP02		;IT IS OK
INP07:	INPERR			;ISSUE FATAL ERROR
INP02:	CLR	-(SP)		;SET THE LIMITS OF ADDRESSES
	MOV	R1,-(SP)	;SAVE THE TEXT POINTER
INP10:	JSR	PC,STAT		;GET STATUS WORD ADDRESS
	BIC	#10,B.STUS(R0)	;TURN OFF ^O
	MOV	WORK,R2
	TST	INDEV(R2)	;IS THE INPUT FROM THE TTY?
	BNE	INP08		;NO, DON'T DO "?" JUNK.
	MOV	#'?,R2		;TELL HIM TO GET WITH IT
	JSR	PC,PRNT00
INP08:	MOV	WORK,R1
	MOV	INDEV(R1),R1	;GET INPUT DEVICE
	JSR	PC,PCK00	;GET A LINE
	JSR	PC,FILL00	;TRY TO SATISFY THE REQUEST
	BVS	INP06		;OVERFLOW IS BACK DATA
	BGT	INP04		;TOO MUCH INPUT TYPED
	BLT	INP05		;NOT ENOUGH INPUT TYPED
	MOV	(SP)+,R1	;RECOVER THE TEST ADDRESS
	TST	(SP)+		;REMOVE FIRST 0
	TST	(SP)+		;REMOVE A WORD AND CHECK FOR THE END
	BNE	.-2		;LOOP FOR MORE
	DEC	R1		;BACK UP CHARACTER POINTER
	MOV	WORK,R2
	TST	RUNF(R2)	;CHECK FOR IMMEDIATE MODE
	BNE	PR15		;OMIT THIS LITTLE BIT IF RUNNING
	MOVB	#012,@R1
	JMP	INIT02

INP04:	IN1ERR			;HE TYPED TOO MUCH
	BR	INP10		;TRY AGAIN
INP05:	IN2ERR			;HE DIDN'T TYPE ENOUGH
	BR	INP10		;TRY AGAIN
INP06:	IN3ERR			;HE IS A LOUSY TYPIST
	BR	INP10		;TRY AGAIN

FILL00:	MOV	SP,R4		;USE R4 FOR A WHILE
	CMP	(R4)+,(R4)+	;POINTS TO THE LAST ZERO NOW
	TST	(R4)+		;POINTS TO THE LAST ADDRESS
	TST	(R4)+		;GO FIND THE FIRST 0
	BNE	.-2		;LOOP TILL FOUND
	TST	-(R4)		;R4 POINTS TO THE FIRST 0
FILL01:	MOV	-(R4),R0	;PICK UP A VARIABLE ADDRESS
	BEQ	FILL06		;NOT ENOUGH DATA
	MOV	R4,-(SP)	;SAVE THE LIST POINTER
	JSR	PC,ATOF00
	BVS	FILL99		;I WISH HE COULD TYPE
	MOV	(SP)+,R4	;RESTORE LIST POINTER
	CMPB	@R1,#',		;CHECK THE SEPARATOR
	BEQ	FILL02		;IT'S A COMMA
	CMPB	@R1,#':
	BEQ	FILL03		;IT'S A COLON
	CMPB	@R1,#012
	BEQ	FILL03		;IT'S A <LF>
FILL05:	SEV			;SET OVERFLOW
FILL04:	RTS	PC		;RETURN
FILL02:	INC	R1		;SKIP THE SEPARATOR
	BR	FILL01		;TAKE ANOTHER CONVERSION
FILL03:	MOV	-(R4),R0	;SEE IF THE NEXT ONE IS VALID
	BEQ	FILL04		;EXIT IF OK
	SEN			;TELL HIM NOT ENOUGH DATA
	RTS	PC		;RETURN
FILL06:	CCC			;MAKE MORE DATA THAN VAR.
	RTS	PC		;AND EXIT
FILL99:	TST	(SP)+		;REMOVE LIST POINTER
	BR	FILL05		;AND EXIT
;
; COMMON EXPRESSION HANDLER FOR READ AND INPUT
;
COM00:	JSR	PC,GTDR00	;GET NAME
	BVS	FILL05		;BAD NAME
	BNE	COM01		;OK IF FOUND
	MOV	R4,R0		;SET UP THE NAME
	JSR	PC,PSH00			;PUSH VARIABLE ON LIST
COM01:	MOV	(SP)+,R2	;SAVE RETURN ADDRESS
	MOV	R0,-(SP)	;SAVE THE VARIABLE ADDRESS
	MOV	#4,R0		;SEE IF FOUR
	JSR	PC,TSTU00	; BYTES ARE AVAILABLE
	BLO	COM03		;     OVERFLOW IF NOT AVAILABLE
	MOV	R2,-(SP)	;REPLACE THE RETURN ADDRESS ON THE STACK
	JSR	PC,SKIP00
	CMPB	R2,#',		;CHECK FOR A GOOD SEPARATOR
	BEQ	COM00		;COMMAS ARE OK
	CMPB	R2,#':		;SO IS A SEMI-COLON
	BEQ	FILL04
	CMPB	R2,#12		;SO IS A <LF>
	BEQ	FILL04
	BR	FILL05
COM03:	OVFERR			;OVERFLOW
READ00:	MOV	#1,-(SP)	;A BACK STOP FOR THE LANDMARK
	CLR	-(SP)		;A LANDMARK
	JSR	PC,COM00
	BVC	READ02
	REAERR
READ02:	CLR	-(SP)
	MOV	R1,-(SP)
	MOV	WORK,R2
	MOV	DATI(R2),R1		;PICK UP THE CURRENT POINTER
	BNE	READ03		;START NOW IF WE ARE SOME WHERE
	MOV	USR(R2),R1		;START FROM THE BEGINING
	BR	READ05		;AND LOOK FOR A DATA STATEMENT
READ03:	CMPB	@R1,#12		;NEXT
	BEQ	READ05		;DATA STATEMENT
	JSR	PC,FILL00	;GO GET DATA
	BVS	READ07		;OH NO AN ERROR
	BLT	READ04		;BRANCH ON NOT ENOUGH DATA
	MOV	WORK,R2
	MOV	R1,DATI(R2)		;SAVE THE POINTER FOR NEXT TIME
	MOV	(SP)+,R1	;GET BACK THE TEXT POINTER
	TST	(SP)+		;POP THE TOP 0
	TST	(SP)+		;POP TO THE LANDMARK
	BNE	.-2		;LOOP FOR MAORE
	TST	(SP)+		;THEN GO TO THE BACK STOP
	BEQ	.-2		;LOOP FOR MORE IF ANY
	DEC	R1
	JMP	INIT02		;BACK TO THE BOSS
READ04:	TST	(R4)+		;R4 POINTS TO THE LAST GOOD VARIABLE
	CLR	(R4)+		;CLEAR IT AND ANY OTHERS TO THE
	TST	@R4		;LAND MARK WE LAID DOWN BEFORE
	BNE	.-4		;LOOP TIL WE FIND THAT 0
READ05:	JSR	PC,TXT00	;FIND THE UPPER LIMIT
READ06:	CMPB	#147,(R1)+	;IS WE AT A DATA STATEMENT??
	BEQ	READ03		;IF SO GO FINISH WHAT WE STARTED
	CMP	R1,R3		;SEE IF IT'S ALL OVER
	BLO	READ06		;BRANCH IF MORE TEXT
	RE1ERR			;FATAL ERROR
READ07:	RE2ERR			;FATAL ERROR
;
; FOR <VARIABLE> = <FORMULA> TO <FORMULA> STEP <FORMULA>.  SET UP
;	AND EXECUTE THE "FOR"STATEMENT.  REGISTERS USED - ALL.
;
FOR00:	CLR	-(SP)		;RESERVE ONE WORD
	JSR	PC,GETV00	;GET THE CONTROL VARIABLE
	CMP	R2,#'=		;IS IT A SIMPLE VARIABLE?
	BNE	FOR99		;NO
	CLR	R0		;ZERO MASK
	MOV	R4,-(SP)	;SAVE CONTROL VARIABLE ADDRESS
	JSR	PC,TXT00	;GET ADDRESS OF LIST
	JSR	PC,SRL00	;FIND THE VARIABLE
	BNE	FOR01		;FOUND IT
	MOV	R4,R0		;PUT THE VARIABLE
	JSR	PC,PSH00	;AWAY
	BR	FOR02		;DATA ADDRESS IN R0
FOR01:	MOV	R3,R0
	ADD	#6,R0		;GET DATA ADDRESS IN R0
FOR02:	MOV	R0,-(SP)	;PUT IT AWAY
	CLR	R0		;ZERO MASK
	JSR	PC,TXT00
	BIS	#040000,R4	;LOOK FOR THE "FOR" ITEM
	JSR	PC,SRL00
	BEQ	FOR03		;NONE THERE
	MOV	R4,-(SP)	;SAVE NEW HEADER
	MOV	R1,-(SP)	;SAVE TEXT POINTER
	MOV	#20,R4		;DELETE 16 BYTES FROM THE LIST
	JSR	PC,SCR00
	MOV	(SP)+,R1	;RESTORE TEXT POINTER
	MOV	(SP)+,R4		;RESTORE HEADER
FOR03:	MOV	R4,R0
	JSR	PC,PUSH00	;PLACE HEADER ON THE LIST
	MOV	WORK,R0
	MOV	LINENO(R0),R0
	JSR	PC,PUSH00	;LINE NUMBER GOES SECOND
	JSR	PC,EVAL00	;GET THE STARTING FORMULA
	MOV	@SP,R0		;DESTINATION
	MOV	R2,(R0)+	;PUT
	MOV	R3,(R0)+	; AWAY THE
	MOV	R4,(R0)+	;  VALUE
	MOV	R4,-(SP)
	MOV	R3,-(SP)
	MOV	R2,-(SP)
	JSR	PC,TWO00	;GET TWO BYTES
	CMP	R4,#"OT		;IS IT A "TO"?
	BNE	FOR99		;NO
	JSR	PC,EVAL00	;YES
	MOV	R4,-(SP)
	MOV	R3,-(SP)
	MOV	R2,-(SP)
	JSR	PC,PUT00	;PUT ENDING VALUE AWAY
	CMPB	@R1,#'S		;IS THIS A "STEP"?
	BNE	FOR05		;NO
	JSR	PC,TWO00	;YES
	CMP	R4,#"TS		;LOOK FOR "ST"
	BNE	FOR99		;NOT FOUND
	JSR	PC,TWO00
	CMP	R4,#"PE		;AND "EP"
	BNE	FOR99		;NOT FOUND
	JSR	PC,EVAL00	;EVALUATE THE STEP VALUE
FOR04:	JSR	PC,PUT00	;PUT THE VALUE AWAY
	MOV	R1,20(SP)	;SAVE TEXT POINTER
	JSR	PC,CMPF00
	BEQ	FOR13		;GO DO LOOP IF VARIABLE = END VALUE
	BGT	FOR08		;END LESS THAN CONTROL
	TST	-4(R5)		;IS THE STEP > 0
	BLT	FOR09		;NO, LOOP IS ALL WASHED UP
FOR13:	ADD	#12,SP
	MOV	(SP)+,R1	;STEP IS OK, GO DO LOOP
FOR12:	JMP	INIT02		;GO DO NEXT STATEMENT
FOR05:	CLR	R2		;DEFAULT
	MOV	#040000,R3	; STEP
	MOV	#100001,R4	;  IS ONE
	BR	FOR04
FOR99:	FORERR
FOR08:	TST	-4(R5)		;IS STEP < 0?
	BLT	FOR13		;YES, ALL IS OK
FOR09:	ADD	#10,SP
	MOV	2(SP),R1	;RESTORE TEXT POINTER
	JSR	PC,TXT00	;STEP IS WRONG OR LOOP IS DONE
FOR10:	CMPB	(R1)+,#157	;LOOK FOR A NEXT
	BEQ	FOR11
	CMP	R1,R3		;DONE?
	BLO	FOR10		;NO
	NXTERR			;YES, NO MATCHING NEXT
FOR11:	JSR	PC,GETV00
	CMP	R4,@SP		;IS VARIABLE CORRECT?
	BNE	FOR10		; LOOP UNTIL FOUND OR FAILURE
	CMP	(SP)+,(SP)+	;WE-UNS IS HERE BOSS
FOR15:	DEC	R1
	BR	FOR12		;AND IS DONE
;
; NEXT <SIMPLE VARIABLE> - TERMINATE THE "FOR" LOOP
;	REGISTERS USED - ALL.
;
NEXT00:	CLR	-(SP)		;SAVE SOME SPACE
	CLR	R0		;ZERO MASK
	JSR	PC,GETV00	;GET THE CONTROL VARIABLE
	MOV	R4,-(SP)	;SAVE CONTROL VARIABLE NAME
	JSR	PC,TXT00
	JSR	PC,SRL00	;FIND THE VARIABLE
	BEQ	NEXT99		;NEXT WITHOUT FOR
	MOV	R3,-(SP)	;SAVE ADDRESS OF VARIABLE
	BIS	#040000,R4
	JSR	PC,TXT00	;FIND
	JSR	PC,SRL00	;THE CORRESPONDING "FOR" ELEMENT
	BEQ	NEXT99		;NOT FOUND
	MOV	R1,4(SP)	;SAVE TEXT POINTER
	CMP	(R3)+,(R3)+	;ADDRESS OF END VALUE
	MOV	R3,R1
	ADD	#6,R1		;GET THE STEP
	MOV	(SP),R0	;ADDRESS
	MOV	R3,-(SP)
	MOV	4(R3),-(SP)
	MOV	2(R3),-(SP)
	MOV	@R3,-(SP)
	ADD	#6,R0		; OF CONTROL VARIABLE
	MOV	R0,-(SP)	;SAVE C.V. ADDR. TEMPORARILY
	JSR	PC,ADDF00	;ADD THE STEP TO IT
	MOV	(SP)+,R0
	MOV	4(R0),-(SP)
	MOV	2(R0),-(SP)
	MOV	@R0,-(SP)
	MOV	14(SP),R3
	TST	10(R3)		;CHECK SIGN OF STEP
	BPL	NEXT02		;POSITIVE, DO NORMAL COMPARE
	JSR	PC,CMPF00	;DO THE COMPARE
	BGT	NEXT01		; BACKWARDS
	BR	NEXT03
NEXT02:	JSR	PC,CMPF00	;EQUAL?
	BLT	NEXT01		;YES, ALL DONE
NEXT03:	ADD	#6,SP
	MOV	(SP)+,R0	;ENDVALUE
	TST	-(R0)
	MOV	@R0,R0		;GET LINE NUMBER
	JSR	PC,FIND00	;FIND WHERE IT BELONGS
	CMPB	(R1)+,(R1)+	;SKIP OVER LINE NUMBER
	JSR	PC,JUNK00	;SKIP TO NEXT STATEMENT
	ADD	#6,SP
	BR	FOR12
NEXT99:	NXMERR			;NEXT WITHOUT FOR
NEXT01:	ADD	#6,SP
	MOV	(SP)+,R1	;GET STEP SIZE
	ADD	#6,R1		;HERE
	MOV	(SP),R0		;AND CONTROL VARIABLE ADDRESS
	ADD	#6,R0		;HERE
	JSR	PC,SUBF00	;THEN SUBTRACT STEP TO MAKE IT RIGHT
	CMP	(SP)+,(SP)+	;DSICARD TWO WORDS
	MOV	(SP)+,R1	;NEXT IS TEXT POINTER
	BR	FOR15
	.EOT			;END OF TAPE 8
;
;
;PDP-11 FLOATING POINT PACKAGE
;
RND00:	MOV	WORK,R2
	MOV	R0,-(SP)	;SAVE THE DESTINATION
	MOV	M.I(R2),R0	;GET THE LAST NUMBER
	MOV	M.K,R1		;GET THE GENERATOR
	JSR	PC,IMUL00
	BIC	#100000,R0	;CLEAR SIGN BIT
	MOV	WORK,R2
	MOV	R0,M.I(R2)	;SAVE FOR NEXT TIME
	MOV	R0,R1
	MOV	@SP,R0		;SETUP TO FLOAT
	JSR	PC,FLT00
	MOV	(SP)+,R0	;POP THE DESTINATION
	SUB	#17,4(R0)	;ADJUST FOR FIXED POINT ON THE RIGHT
	RTS	PC
M.K:	.WORD	403		;=64*8+3
;
; RANDOMIZE STATEMENT
;
RND01:	MOV	WORK,R2
	MOV	RNDM(R2),M.I(R2)	;GET THE RANDOM WORD
	BIS	#1,M.I(R2)	;MAKE IT ODD
	JMP	INIT02
ATOF00:	MOV	R5,-(SP)	;SAVE R5
	MOV	R0,-(SP)	;SAVE THE DEFA
	CLR	(R0)+		;CLEAR HIGH ORDER FRACTION
	CLR	(R0)+		;CLEAR LOW ORDER FRACTION
	CLR	@R0		;CLEAR THE EXPONENT
	CLR	-(SP)		;CLEAR EXP1
	CLR	-(SP)		;CLEAR EXP2
	CLR	-(SP)		;CLEAR THE SWITCHES
M.AFXN:	JSR	PC,SKIP00	;GET A CHARACTER FRON THE INPUT STRING
	CMPB	#105,R2		;LOOK FOR AN E
	BEQ	M.AFE		;BRANCH IF AN E IS FOUND
	CMPB	#55,R2		;LOOK FOR A MINUS
	BEQ	M.AFMI		;BRANCH IF A MINUS SIGN
	CMPB	#53,R2		;LOOK FOR A PLUS
	BEQ	M.AFPL		;BRANCH IF A PLUS SIGN
	CMPB	#56,R2		;LOOK FOR A DECIMAL POINT
	BEQ	M.AFD		;BRANCH IF A DECIMAL POINT
	JSR	PC,TST00	;MAKE SURE IT IS NUMERIC
	BNE	M.AFTX		;ERROR IF NOT NUMERIC
	SUB	#60,R2		;CONVERT TO A BINARY NUMBER
	MOV	R1,-(SP)	;SAVE THE SEFA
	BIT	#4,2(SP)	;TEST THE E SWITCH
	BNE	M.AFXP		;BRANCH IF COLLECTING EXPONENT
	SUB	#6,SP		;PUT A FLOATING POINT NUMBER ON STACK
	MOV	SP,R0		;SET UP THE DEFA FOR FLT
	MOV	R2,R1
	JSR	PC,FLT00	;FLOAT THE INTEGER
	MOV	16(SP),R0	;GET THE DEFA
	MOV	#M.TEN,R1	;GET THE ADDRESS OF 10.
	JSR	PC,MULF00	;MULTIPLY BY 10.
	BVS	M.AFVT		;OVERFLOW IS A NO-NO
	MOV	16(SP),R0	;FIX UP THE DEFA POINTER
	MOV	SP,R1		;SET UP THE SEFA POINTER
	JSR	PC,ADDF00	;ADD THE CURRENT DIGIT
	BIT	#10,10(SP)	;TEST THE D SWITCH
	BEQ	.+6	;->	;IF ZERO DON'T TOUCH EXP2
	DEC	12(SP)	;  I	;DECREMENT EXP2
	ADD	#6,SP	;<-	;CLEAR UP THE STACK
M.AFSS:	MOV	(SP)+,R1	;PICK UP THE SEFA
	BIS	#1,@SP		;SET THE S SWITCH
	BR	M.AFXN		;GO GET MORE STUFF
M.AFXP:	MOV	R2,-(SP)	;PUSH THE CURRENT DIGIT
	MOV	10(SP),R3	;GET THE OLD EXPONENT
	MOV	#12,R5		;PUT DECIMAL 10 IN R5
	CLR	R2		;CLEAR REGISTERS FOR
	CLR	R4		;THE BIG MULTIPLY
	CMP	R3,#980.
	BGT	M.AFVU
	JSR	PC,MDPIM	;MULTIPLY BY TEN
	ADD	(SP)+,R3	;ADD THE CURRENT DIGIT
	MOV	R3,6(SP)	;SAVE IT BACK ON THE STACK
	BR	M.AFSS		;SET S SWITCH
M.AFE:	BIT	#4,@SP		;SEE IF THSI IS THE FIRST E
	BNE	M.AFVS		;ERROR IF MORE THAN ONE E
	BIS	#4,@SP		;SET THE E SWITCH
	BIC	#1,@SP		;CLEAR THE S SWITCH
	BR	M.AFXN		;GET THE NEXT CHARACTER
M.AFD:	BIT	#14,@SP		;TEST E AND D SWITCHES
	BNE	M.AFVS		;EITHER ONE SET IS AN ERRROR
	BIS	#10,@SP		;SET THE D SWITCH
	BR	M.AFXN		;SET START OF SIGNIFICANCE
M.AFPL:	BIC	#400,@SP	;CLEAR THE M SWITCH
	BR	.+4	;->	;SKIP THE NEXT INSTRUCTION
M.AFMI:	BIS	#400,@SP;  I	;SET THE M SWITCH
	BIT	#4,@SP	;<-	;TEST THE E SWITCH
	BNE	M.AFSE		;BRANCH IF SIGN OF THE EXPONENT
	BIT	#1,@SP
	BNE	M.AFTX
	BIT	#30,@SP		;TEST THE A, D, AND S SWITCHES
	BNE	M.AFVS		;IF EITHER IS SET AN ERROR IS HERE
	BIS	#20,@SP		;SET THE A SWITCH
	BIT	#400,@SP	;TEST IF A MINUS SIGN
	BEQ	M.AFXN		;RETURN IF PLUS SIGN
	BIS	#100,@SP	;SET MINUS SIGN
	BR	M.AFXN		;GET THE NEXT CHARACTER
M.AFSE:	BIT	#01,@SP		;TEST B AND S SWITCHES
	BNE	M.AFTX		;ERROR IF EITHER IS SET
	BIT	@SP,#40
	BNE	M.AFVS
	BIS	#40,@SP		;SET THE B SWITCH
	BIT	#400,@SP	;TEST FOR A MINUS SIGN
	BEQ	M.AFXN		;EXIT IF A PLUS
	BIS	#200,@SP	;SET MINUS EXPONENT
	BR	M.AFXN		;GET NEXT CHARACTER
M.AFVS:	BIS	#2,@SP		;SET V SWITCH
	BR	M.AFTX
M.AFVT:	ADD	#10,SP		;REMOVE 8 WORDS FROM THE STACK
	MOV	(SP)+,R1	;RESTORE POINTER TO TEXT
	BR	M.AFVS		;SET V AND EXIT
M.AFVU:	CMP	(SP)+,(SP)+	;POP ONE WORD OFF THE STACK
	BR	M.AFVS		;SET V AND EXIT
M.AFTX:	MOV	R1,-(SP)	;SAVE THE SOURCE POINTER
	BIT	#100,2(SP)	;SEE IF IT SHOULD BE NEGATIVE
	BEQ	M.AFX2		;BRANCH OF NO CONVERSION
	MOV	10(SP),R0	;PICK UP DEFA
	MOV	R0,R1		;MAKE SEFA=DEFA
	JSR	PC,NEGF00	;NEGATE THE NUMBER
M.AFX2:	BIT	#200,2(SP)	;SEE IF A NEGATIVE EXPONENT
	BEQ	M.AFX3		;BRANCH IF NO NEGATION
	NEG	6(SP)		;NEGATE THE EXPONENT
	BVC	M.AFX3		;TEST FOR VALID EXPONTNE
	BIS	#2,2(SP)		;SET THE V BIT
	BR	M.AFX5		;EXIT WITH ERROR
M.AFX3:	ADD	4(SP),6(SP)	;REMEMBER ANY DECIMAL PLACES
	BEQ	M.AFX5		;BRANCH IF NO CONVERSION
	BLT	M.AFDV		;IF LESS THEN ZERO DIVIDE
M.AFX4:	MOV	10(SP),R0	;SET UP DEFA=#
	MOV	#M.TEN,R1	;SET UP SEFA=10.
	JSR	PC,MULF00	;MULTIPLY BY 10.
	DEC	6(SP)		;DECREMENT AND TEST
	BGT	M.AFX4		;FOR DONE
	BR	M.AFX5		;BYPAS DIVIDE SECTION
M.AFDV:	MOV	10(SP),R0	;SET UP DEFA=#
	MOV	#M.TEN,R1	;SET UP SEFA=10.
	JSR	PC,DIVF00	;DIVIDE BY 10.
	INC	6(SP)		;INCREMENT AND TEST
	BLT	M.AFDV		;FOR COMPLETION 
M.AFX5:	MOV	(SP)+,R1	;RESTORE THE SOURCE POINTER
	DEC	R1		;POINT TO DELIMITER
	MOV	(SP)+,R4	;SAVE THE SIWTCHES
	ADD	#6,SP		;REMOVE 3 MORE WORDS FORM THE STACK
	MOV	(SP)+,R5	;RESTORE R5
	BIT	#2,R4		;TEST FOR V SETTING
	BEQ	.+4	;->
	SEV			;ASCII ERROR
	RTS	PC
M.TEN:	.WORD	000000,050000,100004	;FLOATING POINT 10.
M.ONE:	.WORD	000000,040000,100001	;FLOATING POINT 1.
M.TEN6:	.WORD	000000,075022,100024	;FLOATING POINT 10.^6
M.TEN7:	.WORD	040000,046113,100030	;FLOATING POINT 10.^7
M.FIVE:	.WORD	000000,40000,100000	;FLOATING POINT .5
FTOA00:	MOV	#12,R0		;PUT SOME WORDS ON THE STACK
	CLR	-(SP)		;CLEAR A WORD OF STACK
	DEC	R0		;DECREMENT THE COUNTER
	BGT	.-4		;LOOP IF MORE TO DO
	JSR	PC,MOVS00
	MOV	#030040,10(SP)	;MOVE A SP 0 TO THE OUTPUT
	MOVB	#040,12(SP)	;FOLLOW WITH A SPACE
	TST	R3		;TEST THE SIGN OF THE NUMBER
	BEQ	M.XAXT		;IF 0 WE'RE DONE ALREADY
	BGT	M.XA1		;IF NEGATIVE MAKE POSITIVE
	MOV	SP,R0		;POINT TO OUR NUMBER FOR
	MOV	R0,R1		;BOTH SOURCE AND DESTINATION
	JSR	PC,NEGF00
	MOVB	#55,10(SP)	;MOVE IN A - SIGN
M.XA1:	MOV	#M.TEN6+6,R1	;START THE RANGING PROCESS
	MOV	-(R1),-(SP)
	MOV	-(R1),-(SP)
	MOV	-(R1),-(SP)
	JSR	PC,CMPF00
	BLT	M.XA3		;BRANCH IF TOO SMALL
M.XA2:	MOV	#M.TEN7+6,R1	;OK LN THE LOW COMPARE
	MOV	-(R1),-(SP)
	MOV	-(R1),-(SP)
	MOV	-(R1),-(SP)
	JSR	PC,CMPF00
	BLT	M.XA4		;BRANCH IF RANGING IS DONE
	MOV	#M.TEN,R1
	MOV	SP,R0		;DIVIDE BY 10
	JSR	PC,DIVF00
	INC	6(SP)		;MAKE THE EXPONENT LARGER
	BR	M.XA2		;SEE IF IT'S IN RANGE YET
M.XA3:	MOV	#M.TEN,R1
	MOV	SP,R0		;MULTIPLY BY 10
	JSR	PC,MULF00
	DEC	6(SP)		;MAKE THE EXPONENT SMALLER
	BR	M.XA1		;SEE IF IT'S BIG ENOUGH
M.XA4:	MOV	#M.FIVE,R1	;ROUND UP WITH .5
	MOV	SP,R0
	JSR	PC,ADDF00
	SUB	#100037,4(SP)
M.XA6:	ASR	2(SP)
	ROR	(SP)
	INC	4(SP)
	BNE	M.XA6
	MOV	SP,R0
	ADD	#16,R0		;POINT TO THE OUTPUT AREA
	MOV	SP,R1		;CONVERT TO ASCII
	MOV	R0,-(SP)	;SAVE R0 FOR LATER
	JSR	PC,JTOA00
	MOV	R0,R2		;GET THE POINTER
	DEC	R2		;TO THE LAST DIGIT PLUS ONE
	MOV	(SP)+,R0	;GET THE OUTPUT AREA ADDRESS
	MOV	R2,R1
	SUB	R0,R1
	CMP	R1,#10
	BEQ	M.XA5
	INC	6(SP)		;SIGNIFANCE STARTS HERE
M.XA5:	INC	R0		;GO TO THE NEXT POSITION
	ADD	#7,6(SP)	;DO A FINAL ADJUSTMENT TO THE EXPONENT
	MOV	#10,R1		;USE R1 TO COUNT SIGFIGS
	DEC	R1		;REDUCE THE SIG FIG COUNT
	CMPB	#60,-(R2)	;SEE IF IT'S SIGNIFICANT
	BEQ	.-6		;LOOP IF INSIGNIFICANT
	MOV	SP,R4
	ADD	#11,R4		;MOVE TO THE REAL OUTPUT AREA
	CMP	#10,6(SP)	;SEE WHAT FORMAT TO USE
	BLE	M.XAE		;BRANCH IF E FORMAT
	CMP	#-10,6(SP)	;CHECK THE LOWER LIMIT TOO
	BGE	M.XAE		;BRANCH IF E FORMAT
	MOV	R1,R3		;USE A TEMPORARY REGISTER
	NEG	R3
	ADD	6(SP),R3	;ADD THE EXPONENT
	ADD	#7,R3		;ADD CONSTANT OFFSET
	BLT	M.XAE		;BRANCH IF READY FOR E FORMAT
	MOV	6(SP),R3	;F FORMAT FOR SURE
	BLT	M.FA1		;IF NEGATIVE SHIFT RIGHT
	BGT	M.FA3		;IF POSITIVE MOVE DEC PT RIGHT
M.FA4:	MOVB	#56,(R4)+	;OUTPUT A DEC PT
M.FA0:	MOVB	(R0)+,(R4)+	;MOVE A DIGIT
	CMP	R0,R2		;SEE IF WE ARE DONE
	BLOS	M.FA0		;LOOP IF NOT
M.FA5:	MOVB	#040,(R4)+	;INSERT A TRAILING SPACE
	CLRB	@R4		;FOLLOW WITH A NULL FOR PRINTL
M.XAXT:	ADD	#10,SP		;CLEAN UP THE STACK
	MOV	22(SP),PC	;RETURN
M.FA1:	MOVB	#56,(R4)+	;OUTPUT A DECIMAL PT
M.FA2:	MOVB	#60,(R4)+	;OUTPUT A LEADING 0
	INC	R3		;DECREMENT NEGATIVE COUNTER
	BLT	M.FA2		;SEE IF DONE INSERTING
	BR	M.FA0		;GO OUTPUT THE SIGNIFICANT DIGITS
M.FA3:	MOVB	(R0)+,(R4)+	;MOVE A DIGIT
	DEC	R3		;REDUCE THE COUNT
	BGT	M.FA3		;LOOP IF NOT DONE
	CMP	R0,R2		;SEE IF THERE IS ANY MORE SIGNIFICANCE
	BLOS	M.FA4		;IF MORE CONTINUE
	BR	M.FA5		;ELSE EXIT

M.XAE:	MOVB	#56,(R4)+	;OUTPUT A DEC PT
M.EA0:	MOVB	(R0)+,(R4)+	;OUTPUT A DIGIT
	CMP	R0,R2		;SEE IF ALL THE GOOD ONES ARE OUT
	BLOS	M.EA0		;LOOP IF NOT
	MOVB	#105,(R4)+	;OUTPUT AND E
	ADD	#6,SP		;REMOVE UNUSED STACK SPACE
	MOV	@SP,R1		;GET THE EXPONENT
	MOV	SP,R0		;GO TO THE OUTPUT AREA
	ADD	#14,R0
	MOV	R0,-(SP)	;SAVE R0 THE DESTINATION
	MOV	R4,-(SP)	;SAVE R4 THE OUTPUT AREA
	JSR	PC,ITOA00
	MOV	(SP)+,R4	;REASORE R4
	MOV	(SP)+,R0	;GET BACK ALL THE GOODIES
M.EA1:	CMPB	(R0)+,#40	;COMPARE WITH A SPACE
	BEQ	M.EA1		;LOOP IF A SPACE
	CMPB	-(R0),#55	;SEE IF ITS -
	BEQ	M.EA2
	DEC	R0		;BACK UP OVER SPACE
M.EA2:	MOVB	(R0)+,(R4)+	;OUTPUT A DIGIT
	TSTB	@R0		;LOOK FOR TRAILING ZERO
	BNE	M.EA2		;LOOP IF NOT DONE
	CLRB	@R4		;FOLLOW WITH A NULL
	TST	(SP)+		;CLEAN UP THE STACK
	MOV	22(SP),PC	;RETURN
ATOI00:	CLR	R0		;PUT THE NUMBER IN R0
M.AINX:	MOVB	(R1)+,R2	;GET A CHARACTER
	CMPB	R2,#' 		;IS IT A SPACE?
	BEQ	M.AINX		;YES
	SUB	#60,R2		;REDUCE TO A BINARY VALUE
	BLT	M.AIXT		;NOT NUMERIC
	CMP	R2,#11		;TOO BIG FOR NUMERIC?
	BGT	M.AIXT		;TOO BIG
	ASL	R0		;MULTIPLY THE CURRENT NUMBER BY
	ADD	R0,R2		;10 VIA X*2+X*8+CURRENT DIGIT
	ASL	R0
	ASL	R0
	ADD	R2,R0
	BIT	#160000,R0	;TEST FOR TOO BIG
	BEQ	M.AINX		;OK IF IN RANGE
	LNNERR			;LINE NUMBER IS REALLY BAD
M.AIXT:	DEC	R1		;RESET POINTER BACK ONE CHAR.
	RTS	PC
;
; INTEGER TO ASCII CONVERTER
;	USE ITOA FOR SINGLE PRECISION INPUT AND JTOA FOR DOUBLE.
;
ITOA00:	CLR	R2		;CLEAR HIGH ORDER
	MOV	R1,R3		;GET LOW ORDER
	BGE	ITA07		;POSITIVE?
	COM	R2		;NO, SET HIGH ORDER TO ALL ONES
	BR	ITA07
JTOA00:	MOV	(R1)+,R3	;GET LOW ORDER
	MOV	@R1,R2		; AND HIGH ORDER
ITA07:	MOV	R5,-(SP)	;SAVE R5
	TST	R2		;CHECK SIGN
	BGE	ITA00		;DO NOTHING IF POSITIVE
	NEG	R2		;OTHERWISE
	NEG	R3		;COMPLEMENT IT
	SBC	R2		;AND
	MOVB	#'-,(R0)+	;  OUTPUT THE SIGN
	BR	ITA06
ITA00:	MOVB	#' ,(R0)+	;STORE SPACE IF POSITIVE
ITA06:	MOV	#-9.,-(SP)	;COUNT OUT NINE TRIES
	MOV	#ITA05,R5	;GET PROTOTYPE LIST
	CLR	R4		;CLEAR LEADING ZERO FLAG
ITA01:	CLR	R1		;SET UP
	DEC	R1		; DIVIDEND FUDGE
ITA02:	INC	R1		;INCREMENT COUNT
	SUB	@R5,R2		;SUBTRACT
	SUB	2(R5),R3	; THE CONSTANT
	SBC	R2
	BPL	ITA02		;LOOP UNTIL SIGN CHANGE
	ADD	(R5)+,R2
	ADD	(R5)+,R3	;ADD FUDGE IN BACKWARDS
	ADC	R2
	TST	R1		;WAS CHARACTER ZERO?
	BNE	ITA03		;NO, GO PACK IT
	TST	R4		;IS IT A LEADING ZERO
	BEQ	ITA04		;YES, IGNORE IT

ITA03:	ADD	#60,R1		;CONVERT TO ASCII
	ADD	R1,R4		;SET ZERO FLAG
	MOVB	R1,(R0)+	;STORE CHARACTER
ITA04:	INC	@SP		;INCREMENT TRY COUNTER
	BMI	ITA01		;RE-LOOP IF NOT DONE
	ADD	#60,R3		;CONVERT LAST CHARACTER
	MOVB	R3,(R0)+	;STORE IT
	MOVB	#' ,(R0)+	;STORE TRAILING SPACE
	CLRB	@R0		;AND TRAILING ZERO
	TST	(SP)+		;GET RID OF STACK SCRAP
	MOV	(SP)+,R5	;RESTORE R5
	RTS	PC
;
; PROTOTYPE TABLE
;
ITA05:	35632,145000		;	1,000,000,000
	2765,160400		;	100,000,000
	230,113200		;	10,000,000
	17,041100		;	1,000,000
	1,103240		;	100,000
	0,23420			;	10,000
	0,1750			;	1,000
	0,144			;	100
	0,12			;	10
;SINGLE PRECISION INTEGER MULTIPLY
;LENGTH =     BYTES
;EXECUTION TIME =       CYCLES-TYPICAL
;
IMUL00:	MOV	R5,-(SP)	;SAVE R5
	MOV	R0,R3		;PICK UP ONE OPERAND
	MOV	R1,R5	;<-	;PICK UP THE OTHER OPERAND
	CLR	R2	;<-	;PREPARE TO
	CLR	R4		;MULTIPLY
	JSR	PC,MDPIM	;GO-GO-GO-ZAP
	MOV	R3,R0	;MOVE THE RESULT TO 
	MOV	R2,R1		;THE DESTINATION
	MOV	(SP)+,R5	;RESTORE R5
	RTS	PC
;	SUBROUTINE TO MULTIPLY TWO DOUBLE PRECISION INTEGERS
;	USES ALL REGISTERS (R0-R5)
;
;	ENTER EITH JSR  PC,M.DPIM
;		MULTIPLIER IN R2-R3
;		MULTIPLICAND IN R4-R5
;		RESULT RETURNED IN R0-R1-R2-R3
;
MDPIM:	CLR	R0		;CLEAR HIGH ORDER WORDS
	CLR	R1
	MOV	#41,-(SP)	;MOVE 33 DEC TO COUNTER
M.DP01:	ROR	R0
	ROR	R1
	ROR	R2		;SHIFT TO ADD
	ROR	R3
	BCC	M.DP02		;NO CARRY NO ADD
	ADD	R5,R1
	ADC	R0		;ADD DOUBLE PRECISION TO OBTAIN NEW PARTIAL 
	ADD	R4,R0		;PRODUCT
M.DP02:	DEC	@SP		;DECREMENT COUNTER
	BNE	M.DP01
	TST	(SP)+		;REMOVE THE COUNTER
	RTS	PC
	.EOT			;END OF TAPE 9


;	DIVISION UTILITY SUBROUTINE
;	R0-R1-R2-R2=DIVIDEND
;	R4-R5=DIVISOR
;	R0-R1=REMAINDER AFTER DIVISION
;	R2-R3=QUOTIENT AFTER DIVISION
;	ENTER WITH JSR	PC,M.DPID
;
MDPID:	MOV	#40,-(SP)	;COUNTER FOR DIVISION CYCLES
	MOV	R4,-(SP)	;HIGH ORDER
	MOV	R5,-(SP)	;LOW ORDER DIVISOR TO THE STACK
	NEG	2(SP)		;FORM NEGATIVE
	NEG	@SP		;VERSION OF THE DIVISOR
	SBC	2(SP)
	ADD	@SP,R1
	ADC	R0		;PERFORM THE INITIAL SUBTRACTION
	ADD	2(SP),R0
	BCS	M.DP50		;IF CARRY THEN OVERFLOW HAS OCCURRED
	CLR	-(SP)		;THIS IS A LONGER LASTING CARRY BIT
M.DP40:	ROL	R3
	ROL	R2
	ROL	R1
	ROL	R0
	TST	@SP		;TEST "CARRY" INDICATOR
	BEQ	M.DP41		;IF NO "CARRY" THEN ADD ELSE SUBTRACT
	CLR	@SP		;CLEAR UP FOR NEXT TIME
	ADD	2(SP),R1
	ADC	R0		;ADD -(DIVISOR)
	ADC	@SP	;  I	;SET "CARRY"
	ADD	4(SP),R0;<-
	BR	M.DP42
M.DP41:	ADD	R5,R1
	ADC	R0		;ADD +(DIVISOR)
	ADC	@SP	;  I	;SET "CARRY"
	ADD	R4,R0	;<-
M.DP42:	ADC	@SP		;SET "CARRY"
	TST	@SP		;TEST THE UPDATE INDICATOR
	BEQ	.+4	;->	;IF ZERO FORGET IT
	INC	R3	;  I	;NO CARRY POSSIBLE HERE
	DEC	6(SP)	;<-	;DECREMENT COUNTER
	BGT	M.DP40		;BRANCH IF MORE TO DO
	ROR	R3
	BCS	M.DP44
	ADD	R5,R1
	ADC	R0
	ADD	R4,R0
	CLC
M.DP44:	ROL	R3
	ADD	#10,SP		;ADJUST STACK BY 4 WORDS
	CLV
	RTS	PC
M.DP50:	ADD	#6,SP
	DVFERR
	SEV
	RTS	PC
ADDF00:	MOV	R5,-(SP)	;SAVE R5
	MOV	R0,-(SP)	;SAVE DEFA
	MOV	(R1)+,-(SP)	;MOVE SOURCE TO R3,R5,EXPA ON STACK
	MOV	(R1)+,-(SP)
	MOV	@R1,-(SP)
	MOV	(R0)+,R2	;MOVE DESTINATION TO R2,R1,R0 IN REGISTERS
	MOV	(R0)+,R1
	MOV	@R0,R0
	CMP	R0,@SP		;IF R0>EXPA SWAP
	BLOS	M.FAD2		;FLOATING POINT NUMBERS
	MOV	SP,R4	
	MOV	R0,R3
	MOV	@R4,R0
	MOV	R3,(R4)+
	MOV	R1,R3
	MOV	@R4,R1
	MOV	R3,(R4)+
	MOV	R2,R3
	MOV	@R4,R2
	MOV	R3,(R4)+
M.FAD2:	SUB	@SP,R0		;R0=R0-EXPA
	BEQ	M.FAD8		;IF ZERO OMIT ALIGNMENT
	BPL	M.FAD3		;IF POSITIVE THEN NO ADD
	CMP	R0,#-37
	BGE	M.FAD4
M.FAD3:	MOV	2(SP),R5
	MOV	4(SP),R3
	BR	M.FAD7
M.FAD4:	CMP	R0,#-20		;IF DIFFERENCE BETWEEN EXPONENTS IS
				;>15 AND <31 DO A FAST RIGHT SHIFT
	BGT	M.FAD5		;ADD 15 TO THE EXPONENT,MOVE HIGH TO
	ADD	#20,R0
	MOV	R1,R2
	CLR	R1
	TST	R2
	BPL	M.FAD5
	COM	R1
M.FAD5:	TST	R0		;IF DIFFERENCE BETWEEN EXPONENTS IS 0
				;THEN SKIP R3IGNMENT LOOP
	BEQ	M.FAD8
M.FAD6:	ASR	R1		;SHIFT FRACTION RIGHT  AND CHECK
	ROR	R2		;IF EXPONENTS ARE R3IGNED YET
	INC	R0
	BNE	M.FAD6
M.FAD8:	MOV	2(SP),R5	;PUT FRACTION A INTO REGISTERS
	MOV	4(SP),R3
	ADD	R2,R3		;DO A DOUR2E PRECISION ADD TO SUM
	ADC	R5		;THE FRACTIONS
	BVS	M.FAD9
	ADD	R1,R5
	BVC	.+10	;->	 IF AN OVERFLOW OCCURS
M.FAD1:	ROR	R5	;  I	 THEN SHIFT THE CARRY BIT
	ROR	R3	;  I	 BACK INTO THE NUMBER AND
	INC	@SP	;  I	 INCREMENT THE EXPONENT
M.FAD7:	MOV	6(SP),R0;<-	 PUT DEFA IN A REGISTER
	MOV	R0,R1		;SAVE DEFA FOR LATER
	MOV	R3,(R0)+	;MOVE FRACTION TO DESTINATION
	MOV	R5,(R0)+
	MOV	@SP,(R0)+
	MOV	R1,R0		;GET UN TOUCHED DEFA
	ADD	#10,SP		;FIX UP STACK
	MOV	(SP)+,R5	;RESTORE R5
	JMP	NORM00
M.FAD9:	ADD	R1,R5
	BCS	M.FAD7		;IF A CARRY NO REAL OVERFLOW
	BR	M.FAD1
;FLOATING POINT SUBTRACTION SUBROUTINE.
;LENGTH = 26 BYTES
;EXECTION TIME = 32 CYCLES + ADDF TIME

SUBF00:	MOV	R0,R4		;SAVE DEFA
	SUB	#6,SP
	MOV	SP,R0
	JSR	PC,NEGF00	;NEGATE
	MOV	R4,R0
	MOV	SP,R1
	JSR	PC,ADDF00	;AND ADD
	ADD	#6,SP
	RTS	PC
;NEGATION SUBROUTINE.NEGATES SOURCE AND PUTS
;RESULT IN DESTINATION
;LENGTH = 22 BYTES

;EXECUTION TIME = 18 CYCLES
ABS00:	JSR	PC,MOVF00
	TST	2(R1)		;TEST FOR NEGATIVE
	BGE	NEGF01		;EXIT IF POSITIVE
NEGF00:	MOV	(R1)+,R2	;MOVE SOURCE FRACTION TO REGISTERS
	MOV	(R1)+,R3	
	NEG	R3		;NEGATE FRACTION IN REGISTERS
	NEG	R2
	SBC	R3
	MOV	R2,(R0)+	;MOVE NEGATIVE FRACTION TO DESTINATION
	MOV	R3,(R0)+
	MOV	(R1)+,(R0)+	;MOVE EXPONENT TO DESTINATION
NEGF01:	RTS	PC
;
; SGN00 - GET THE SIGN OF THE OPERAND
;
SGN00:	JSR	PC,MOVF00	;MOVE TO DEST.
	MOV	#M.TEN+6,R1	;ADDRESS OF 1.
	TST	2(R0)		;TEST ORIGINAL
	BGT	SGN01
	BEQ	SGN02		;IF ZERO WE EXIT
	JSR	PC,NEGF00	;STORE -1.
	RTS	PC
SGN01:	JSR	PC,MOVF00	;STORE +1.
SGN02:	RTS	PC
DIVF00:	MOV	R5,-(SP)	;SAVE R5
	MOV	R0,-(SP)	;SAVE DEFA
	CLR	-(SP)		;SIGN CONTROL WORD
	MOV	(R1)+,R5	;PICK UP THE DIVISOR
	MOV	(R1)+,R4	;HIGH ORDER WORD
	TST	R4		;TEST FOR DIVISION BY ZERO
	BEQ	M.DIVV		;DIVISION BY ZERO IS A NO-NO
	BGE	.+12	;->	IF NEGATIVE
	NEG	R4	;  I	CHANGE THE SIGN
	NEG	R5	;  I	BUT STILL KEEP
	SBC	R4	;  I	TRACK OF THE ORIGINAL
	INC	@SP	;  I	SIGN ON THE STACK
	MOV	(R0)+,R3;<-
	MOV	(R0)+,R2	;PICK UP THE DIVIDEND
	BEQ	M.MUL0		;IF ZERO THEN SHORT DIVIDE
	BGT	.+12	;->	IF NEGATIVE
	NEG	R2	;  I	CHANGE THE SIGN
	NEG	R3	;  I	BUT STILL KEEP
	SBC	R2	;  I	TRACK OF THE ORIGINAL
	DEC	@SP	;  I	SIGN ON THE STACK WORD
	MOV	@R1,R1	;<-	;GET THE EXPONENTS
	NEG	R1		;AND SUBTRACT
	ADD	@R0,R1		;TO CHECK FOR OVER-UNDER-FLOW
	ROR	R1		;AND PUT IT ON THE STACK
	ROL	R1		;WHEN DONE
	BVC	M.DIVV
	ADD	#100000,R1
	MOV	R1,-(SP)
	MOV	R3,R1
	MOV	R2,R0
	CLR	R2		;SET UP TO DO THE DIVIDE
	CLR	R3
	ROR	R0
	ROR	R1
	ROR	R2
	JSR	PC,MDPID	;CALL THE DIVIDE ROUTINE
	NEG	R4		;CHANGE THE SIGN OF THE DIVISOR
	NEG	R5
	SBC	R4
	ASL	R1		;DOUBLE THE REMAINDER
	ROL	R0
	ADD	R5,R1		;ADD -(DIVISOR)
	ADC	R0
	ADD	R4,R0
	BLT	M.DIV2
	ADD	#1,R3		;ROUND UP THE RESULT
	ADC	R2
M.DIV2:	CLC
	ROR	R2
	ROR	R3
	INC	@SP
	TST	2(SP)		;CHECK SIGN  WORD
	BEQ	.+10	;->
	NEG	R2	;  I
	NEG	R3	;  I
	SBC	R2	;  I
	MOV	4(SP),R0;<-	 GET DEFA
	MOV	R3,(R0)+
	MOV	R2,(R0)+
	MOV	(SP)+,@R0
	CMP	(SP)+,(SP)+	;FIX UP THE STACK POINTER
	MOV	(SP)+,R5	;RESTORE R5
	CMP	-(R0),-(R0)	;POINT TO THE DESTINATION
	MOV	R0,R1
	JMP	NORM00
M.DIVV:	CMP	(SP)+,(SP)+	;FIX UP THE STACK
	DVFERR
	MOV	(SP)+,R5	;RESTORE R5
	SEV
	RTS	PC
MULF00:	MOV	R5,-(SP)	;SAVE R5
	MOV	R0,-(SP)	;SAVE DEFA
	MOV	(R1)+,R5	;FETCH SOURCE
	MOV	(R1)+,R4
	MOV	@R1,R1
	CLR	-(SP)		;SIGN CONTROL WORD
	TST	R4
	BEQ	M.MUL0		;SHORT CIRCUIT IF ZERO
	BPL	M.MUL2		;IF NEG MAKE POSITIVE
	NEG	R4		;ZIP-ZAP-
	NEG	R5		;ZOWIE-AND-
	SBC	R4		;SWOSH
	DEC	@SP		;FIDDLE WHITH THE SIGN
M.MUL2:	MOV	(R0)+,R3	;PICK UP DESTINATION
	MOV	(R0)+,R2
	BEQ	M.MUL0		;FAST IF ZERO
	BPL	M.MUL3		;OMIT SIGN CHANGE IF POSITIVE
	NEG	R2
	NEG	R3
	SBC	R2
	INC	@SP		;DO A GOOD JOB ON THE SIGN
M.MUL3:	ADD	@R0,R1		;COMPUTE A TRY AT THE NEW EXPONENT
	ROR	R1
	ROL	R1
	BVC	M.DIVV		;HANDLE OVER-UNDER-FLOW
	ADD	#100000,R1
	MOV	R1,-(SP)
	JSR	PC,MDPIM	;DO THE MULTIPLICATION
	INC	@SP		;ADJUST THE EXPONENT AFTER MULTIPLY
M.MUL8:	ROL	R2		;NOW NORMALIZE
	ROL	R1
	ROL	R0
	BVS	M.MUL4
	DEC	@SP
	BR	M.MUL8
M.MUL4:	ROR	R0
	ROR	R1
	ADC	R1		;ROUND OFF THE RESULT
	ADC	R0
	BVC	M.MUL6
	INC	@SP
	BR	M.MUL4
M.MUL6:	MOV	(SP)+,R2	;DO THE FANCY FOOT WORK
	TST	(SP)+		;REMEMBER THE SIGN WORD WE SAVED?
	BEQ	M.MUL7		;BRANCH FOR POSITIVE RESULT
	NEG	R0
	NEG	R1
	SBC	R0
M.MUL7:	MOV	(SP)+,R3	;WE SAVED THE DESTINATION FOR JUST SUCH A CAUSE
	MOV	R1,(R3)+
	MOV	R0,(R3)+
	MOV	R2,@R3
	MOV	(SP)+,R5
	RTS	PC
M.MUL0:	CLR	R0		;QUICK AND DIRTY
	CLR	R1
	CLR	R2
	TST	(SP)+		;GET RID OF THE SIGN CONTROL WORD
	BR	M.MUL7
;
; CONVERSION OF SINGLE PRECISION INTEGERS TO FLOATING POINT NUMBERS
;
FLT00:	CLR	(R0)+
	MOV	R1,(R0)+
	MOV	#100017,@R0
	CMP	-(R0),-(R0)
	MOV	R0,R1
;
;SUBROUTINE TO NORMALIZE AN UN-NORMALIZED FLOATING POINT NUMBER
;
NORM00:	MOV	(R1)+,R4	;MOVE SOURCE TO REGISTERS
	MOV	(R1)+,R2
	MOV	(R1)+,R3
	MOV	R3,R1		;SAVE FOR LATER CHECK
	TST	R2		;CHECK FOR A ZERO FRACTION
	BNE	M.NOR2
	TST	R4
	BNE	M.NOR2
	CLR	R3		;RETURN 0.0 CAUSE FRACTION=0
	BR	M.RET2
M.NOR2:	INC	R3
M.NORL:	DEC	R3		;NORMR4IZATION LOOP
	ASL	R4		;SHIFT FRACTION LEFT
	ROL	R2
	BVC	M.NORL		;NORMR4IZED YET?
	BCC	M.NOR3		;SPECIR4 -1 FRACTION CHECK
	BNE	M.NOR3	;IF NOT -(2^N) THEN EXIT NOW
	TST	R4
	BNE	M.NOR4
	SEC			;IT WAS -1 TO MAKE IT -1/2
	ROR	R2
	INC	R3
	INC	R1
M.NOR4:	SEC
M.NOR3:	ROR	R2
	ROR	R4
M.RET2:	MOV	R4,(R0)+
	MOV	R2,(R0)+
	MOV	R3,(R0)+
	CMP	R3,R1
	BHI	.+6	;->	;MAKE SURE THE VALUE DIDN'T DECREASE
	CLV		;  I
	RTS	PC	;  I
	SEV		;<-
	RTS	PC
;PDP-11 FLOATING POINT PACKAGE
;FIX,FIXD,FLT,FLTD,CMPF,MOVF
;
;
;ROUTINE FOR MOVING FLOATING POINT NUMBERS FROM SOURCE ADDDRESS TO
;DESTINATION ADDRESS
;
MOVF00:	MOV R1,R2
	MOV R0,R4
	MOV (R2)+,(R4)+
	MOV (R2)+,(R4)+
	MOV (R2)+,(R4)+
	RTS	PC

;
;SUBROUTINE FOR COMPARING TWO FLOATING POINT NUMBERS AND SETTING
;THE INDICATORS WITH OUT MODIFYING EITHER NUMBER.THE INDICATORS
;ARE SET FROM THE SOURCE MINUS DESTINATION.
;
CMPF00:	MOV	(SP)+,R4	;SAVE RETURN ADDRESS
	MOV	(SP)+,R3	;LOF
	MOV	(SP)+,R2	;HOF
	MOV	(SP)+,R0	;EXPONENT
	MOV	R4,-(SP)	;RESTORE RETURN ADDRESS
	MOV	R2,R4
	BIC	#077777,R4
	ADD	4(SP),R4	;CHECK FOR SAME SIGN
	BPL	CMPF01		;
	TST	R2		;DIFFERENT SIGNS HENCE RESULT =SRC
	BPL	CMPF21		;IF + OR ZERO
	BR	CMPF20		;IF -
CMPF01:	MOV	6(SP),R4		;THE OTNER EXPONENT
	BCC	CMPF02
	COM	R0
	COM	R4
CMPF02:	CMP	R0,R4
	BHI	CMPF21		;SIGNS ARE THE SAME
	BLO	CMPF20
	CMP	R2,4(SP)	;CHECK HOF
	BGT	CMPF21
	BLT	CMPF20
	CMP	R3,2(SP)	;CHECK LOF
	BHI	CMPF21
	BLO	CMPF20
	CCC
	SEZ
	RTS	PC		;SRC=DST
CMPF20:	CCC
	RTS	PC
CMPF21:	CCC
	SEN
	RTS	PC		;SRC<DST
;SUBROUTINE TO PUT THE NUMBER POINTED TO BY R0 ON THE STACK
;
MMOVE:	MOV	(SP)+,R2	;MAKE STACK SAME HEIGHT AS AT CALL
	ADD	#6,R0		;MAKE RO POINT TO TOP OF NUMBER
	MOV	-(R0),-(SP)	;MOVE THE NUMBER BACKWARD TO THE
	MOV	-(R0),-(SP)	;STACK SO IT COMES OUT CORRECTLY
	MOV	-(R0),-(SP)
	MOV	R2,PC		;RETURN FAST
INT00:	MOV	(R1)+,R3	;PICK UP THE NUMBER
	MOV	(R1)+,R2	;AND PUT IT IN REGESTERS
	MOV	@R1,R4
	BPL	INT03		;BRANCH IF THE ANSWER IS ZERO
	CMP	-(R1),-(R1)
	CMP	R4,#100037	;SEE IF WE NEED TO DO ANYTHING
	BHIS	MOVF00		;BRANCH IF NO FRACTION PART
	SUB	#100037,R4	;COMPUTE # OF FRACTION BITS
INT01:	ASR	R2
	ROR	R3
	INC	R4		;  INTO PLACE
	BLT	INT01
	MOV	R0,R1
	MOV	R3,(R0)+
	MOV	R2,(R0)+
	MOV	#100037,@R0
	MOV	R1,R0
	BR	NORM00
INT03:	TST	R2
	BPL	INT02
	MOV	#M.ONE,R1
	JMP	NEGF00
INT02:	CLR	(R0)+
	CLR	(R0)+		;CLEAR THREE WORDS-FLT PT 0.
	CLR	(R0)
	RTS	PC
;
; FIX- FIX00, NUMBER IN R2,R3,R4 FIXED TO NUMBER IN R0.
;	REGISTERS USED - R0,R1,R2,R3,R4.
;
FIXS00:	MOV	(R1)+,R2
	MOV	(R1)+,R3
	MOV	@R1,R4
FIX00:	CMP	R4,#100017	;CHECK FOR EXPONENT TOO LARGE
	BHI	FIX04		;JUMP IF EXPONENT TOO LARGE
	BEQ	FIX03		;JUMP IF NO WORK NEEDED
	CMP	R4,#100000	;CHECK FOR ZERO EXPONENT
	BLO	FIX05		;JUMP IF ZERO
	SUB	#100017,R4	;GENERATE BACKWARDS COUNTER
FIX02:	ASR	R3		;MOVE IT ONCE
	INC	R4
	BNE	FIX02		;LOOP UNTIL COUNT EQUALS ZERO
FIX03:	MOV	R3,R0		;PUT RESULT IN R0
	RTS	PC
FIX04:	FIXERR
FIX05:	CLR	R0		;RESULT CAN BE ZERO
	RTS	PC

	.EOT			;END OF TAPE 10
;SIN,COS,LOG,EXP,SQR,ATN
;
;POWER FUNCTION
;
PWRF00:	MOV	R1,-(SP)	;INITIALIZE THE STACK WITH DEFA AND SEFA
	MOV	R0,-(SP)
	SUB	#6,SP		;AND PUT ROOM FOR A NUMBER ON THERE TOO
	MOV	R0,R1		;START WITH LN(A)
	MOV	SP,R0		;AND PUT IT ON THE STACK
	JSR	PC,LOG00
	MOV	10(SP),R1	;CONTINUE WITH B*LN(A)
	MOV	SP,R0
	JSR	PC,MULF00
	MOV	6(SP),R0	;FINISH UP WITH EXP(B*LN(A)) TO THE 
	MOV	SP,R1		;DESTINATION WITH STACK AS SOURCE
	JSR	PC,EXPF00
	ADD	#12,SP		;ONE MUST BE NEAT ABOUT THE STACK
	RTS	PC		;OFF WE GO INTO THE WILD BLUE YONDER!!
;
;FLOATING POINT NATURAL LOGARITHIM ROUTINE
;SOURCE POINTER IN R1
;DESTINATION POINTER IN R0
;
LOG00:	JSR	PC,MINI2
	TST 2(R0)		;Y .LE. 0?
	BGT M.XY
M.YY:	LOGERR
M.YY1:	ADD	#4,SP
	RTS	PC
M.XY:	MOV R0,R1		;DOES Y=1?
	TST (R1)+
	BNE M.XX		;DOES LOW FRACTION=0?
	CMP (R1)+,#40000	;YES. DOES HIGH FRACTION =40000?
	BNE M.XX
	CMP (R1)+,#100001	;YES. DOES EXPONENT =1?
	BNE M.XX
	CLR (R0)+		;YES. CLEAR DESTINATION
	CLR (R0)+
	CLR (R0)+
	BR	M.YY1
M.XX:	MOV 4(R0),-(SP)		;LET N=EXP (Y)
	ADD	#100000,@SP
	MOV	#100000,4(R0)	;LET EXP (Y)=0
	MOV @SP,R1		;FLOAT N AND LEAVE RESULT ON STACK
	SUB #6,SP
	MOV SP,R0
	JSR	PC,FLT00
	MOV 10(SP),R0		;SAVE X ON STACK
	JSR	PC,MMOVE
	MOV #M.RT2B2,R1
	JSR	PC,SUBF00			;DEST=DEST-SQR(2)
	MOV SP,R0		;LET X(STK)=X(STK)+SQR(2)/2
	MOV #M.RT2B2,R1
	JSR	PC,ADDF00
	MOV 16(SP),R0		;LET DEST=DEST/X(STK)
	MOV SP,R1
	JSR	PC,DIVF00
	MOV #M.TABL,R4		;SET UP SETUP ROUTINE
	MOV 16(SP),R0		;LOC OF DESTINATION
	MOV #4,R3		;NUMBER OF CONSTANTS.
	JSR	PC,MSETU
	JSR	PC,MDOPO			;EVALUATE THE POLYNOMIAL
	MOV 16(SP),R0		;LET DEST=DEST-(LN 2)/2
	MOV #M.LGB2,R1
	JSR	PC,SUBF00
	ADD #6,SP		;POP TO FLOATED N
	MOV SP,R0
	MOV #M.LOGE,R1		;LET N=N*LN 2
	JSR	PC,MULF00
	MOV SP,R1		;LET DEST=DEST+N
	MOV 10(SP),R0
	JSR	PC,ADDF00
M.OUT:	ADD #14,SP		;RESTORE SP TO ORIGINAL POSITION
	CLV
	RTS	PC
;
;LOG
M.RT2B:	074626,055202,100000	;SQRT(2)/2
M.LOGE:	005776,054271,100000	;LN 2
M.TABL:	125112,046414,077777	;.300974506336
	007411,063120,077777	;.399659100019
	066333,052525,100000	;.666669470507
	177772,077777,100001	;1.999999993788
EXPF00:	JSR	PC,MINI2	;GET POINTERS
	CMP	4(R0),#100016	;IS EXP(Y)>14
	BHI	M.YY		;YES, ERROR
	MOV #M.LOG2,R1		;NO.
	JSR	PC,MFRAC	;COMPUTE FRACTIONAL PART. RESULT IS IN DEST.
	MOV 2(SP),R0		;LET Y=Y*[LN(2)/2]
	MOV #M.LGB2,R1
	JSR	PC,MULF00
	MOV 2(SP),R0		;SAVE IT TWICE ON STACK
	JSR	PC,MMOVE
	JSR	PC,MMOVE
	MOV SP,R0		;LET TEM1(STK)=A0-Y
	MOV #M.MA0,R1
	JSR	PC,ADDF00
	MOV SP,R0
	MOV R0,R1
	JSR	PC,NEGF00
	INC 12(SP)		;LET NUM(STK)=2Y
	MOV 16(SP),R0
	MOV R0,R1		;LET Y=Y^2
	JSR	PC,MULF00
;AT THIS POINT DEST =Y^2, AND A0-Y AND 2Y ARE ON STACK
	MOV 16(SP),R0		;LET DEST=DEST+B1
	MOV #M.BB1,R1
	JSR	PC,ADDF00
	MOV #M.AA1,R0		;MOVE AA1 ON STACK
	JSR	PC,MMOVE
	MOV SP,R0		;LET A1=A1/DEST
	MOV 24(SP),R1
	JSR	PC,DIVF00
	MOV SP,R0		;LET A1=A1+TEM1(STK). TEM1=A0-Y
	MOV R0,R1
	ADD #6,R1
	JSR	PC,ADDF00
	MOV SP,R1		;LET NUM(STK)=;A1. NUM=2Y
	MOV R1,R0
	ADD #14,R0
	JSR	PC,DIVF00
	ADD #14,SP		;POP TO NUM
	MOV SP,R0
	MOV #M.ONE,R1		;LET NUM=NUM+1
	JSR	PC,ADDF00
	MOV SP,R0
	MOV R0,R1
	JSR	PC,MULF00			;LET NUM=NUM^2
	MOV SP,R1
	MOV 10(SP),R0		;MOVE NUM TO DEST
	JSR	PC,MOVF00
	MOV 10(SP),R0		;EXP(DEST)=EXP(DEST)+INT
	ADD 6(SP),4(R0)
	JMP M.OUT
;
;EXPONENTIAL
M.LOG2:	016624,056125,100001	;LOG(2) E
M.LGB2:	005776,054271,077777	;(LN 2)/2
M.MA0:	037347,117741,100004	;-12.015016753875
M.AA1:	041565,132306,100012	;-601.8042666979565
M.BB1:	026570,074056,100006	;60.09019073192600
;
;EVALS A POLYNOMIAL ACCORDING TO PARAMETERS ON THE STACK
;# OF CONSTANTS
;LOC OF X ON STACK
;LOC OF U1 ON STACK;LOC OF DEST ON STACK
;STARTING LOC OF CONSTANTS
MDOPO:	SUB #2,2(SP)
	MOV 10(SP),R0		;LET DEST=DEST*K(1)
	MOV 12(SP),R1
	MOV R0,-(SP)
	JSR	PC,MULF00
M.LOOP:	ADD #6,14(SP)		;UPDATE CPNSTANT POINTER
	MOV @SP,R0		;DEST = DEST+K(N)
	MOV 14(SP),R1
	JSR	PC,ADDF00
	TST 4(SP)		;TEST THE COUNTER
	BEQ M.HANK		;IF IT ='S 0 THEN GOTO HANK
	MOV @SP,R0		;DEST=DEST*U
	MOV 10(SP),R1
	JSR	PC,MULF00
	DEC 4(SP)		;CNTR=CNTR-1
	BR M.LOOP		;LOOP DONE?
M.HANK:	MOV @SP,R0		;YES. DIVIDE BY X
	MOV 6(SP),R1
	JSR	PC,MULF00
	TST (SP)+
	MOV (SP)+,R3		;SAVE SAVED R5
	ADD #26,SP
	MOV R3,-(SP)
	RTS	PC
;FOLLOWING SUBROUTINE PUSHES THE POINTERS, WHICH ARE
;CONTAINED IN R0 AND R1 ONTO THE STACK, ALONG WITH A FLAG.
;IT ALSO TRANSFERS THE SOURCE FLOATING WORD TO THE DSTINATION
;FLOATING WORD.
MINIT:	MOV (SP)+,R3		;SAVED SAVED R5
	CLR -(SP)		;CLEAR A FLAG
MINI3:	MOV R1,-(SP)		;PUSH ON SOURCE POINTER
	MOV R0,-(SP)		;PUSH ON DEST POINTER
	JSR	PC,MOVF00	;MOVE SOURCE TO DEST
	MOV	R3,PC		;BOY CAN WE BRANCH FAST
MINI2:	MOV	(SP)+,R3		;GET THE RETURN ADDRESS
	BR	MINI3

;SETS UP DOPOL
;POINTER TO DEST IN R0,# OF CONSTANTS IN R3
;LOC OF FIRST CONSTANT IN R4
;SETS UP STACK IN FOLLOWING MANNER: 
;			STARTING LOC OF CONSTANTS (TOP OF STACK)
;		        LOC  OF DESTINATION
;    		        LOC OF THE CONTENTS OF DESTINATION SQUARED
;		        NUMBER OF CONSTANTS
MSETU:	MOV	(SP)+,R1	;SAVE SAVED R5
	JSR	PC,MMOVE	;SAVE X ON STACK
	MOV R1,-(SP)
	MOV R4,-(SP)
	MOV R3,-(SP)
	MOV R0,-(SP)		;SAVE REGISTERS
	MOV R0,R1
	JSR	PC,MULF00
	MOV (SP)+,R0
	MOV (SP)+,R3
	MOV (SP)+,R4
	MOV (SP)+,R1
	JSR	PC,MMOVE	;SAVE  X^2 ON STACK
	MOV R4,-(SP)		;PUSH LOC OF CONSTANT POINTER
	MOV R0,-(SP)		;DEST POINTER
	MOV SP,-(SP)		;U1 POINTER
	ADD #6,@SP
	MOV SP,-(SP)		;X POINTER
	ADD #16,@SP
	MOV R3,-(SP)		;CNTR
	MOV	R1,PC		;BRANCH BACK
;COMPUTES THE FRACTIONAL PART OF SOME NUMBER TIMES DESTINATION.
;R1 POINTS TO THE NUMBER
;R0 POINTS TO THE DESTINATION
;COMPUTATION IS DONE AS FOLLOWS: DEST=DEST-INT(DEST)
MFRAC:	MOV 2(SP),R0
	JSR	PC,MULF00
	MOV (SP)+,2(SP)		;SAVE SAVED R5
	MOV @SP,R1		;PUT DEST POINTER IN R1
	JSR	PC,FIXS00
	MOV	R0,-(SP)
	MOV @SP,R1		;MAKE R1 POINT TO INT
	SUB #6,SP		;MAKE ROOM FOR THE FLOATED INT WHICH WILL BE PUT THERE
	MOV SP,R0
	JSR	PC,FLT00	;FLOAT THE INT AND PUT RESULT ON STACK
	MOV SP,R1		;LET DEST=DEST-INT(DEST)
	MOV 10(SP),R0
	JSR	PC,SUBF00
	ADD #6,SP		;POP PAST FLOATED INT
	MOV 4(SP),-(SP)		;RESTORE SAVED R5
	RTS	PC

SINE00:	JSR	PC,MINIT	;CLEAR FLAGS, PUSH POINTERS
M.SIN1:	TST 2(R0)		;TEST Y
	BGE M.NOTN		;Y<0?
	MOV R0,R1
	JSR	PC,NEGF00	;YES. LET Y=-Y
	INC 4(SP)		;LET NFLAG=1
	BR M.NOTE
M.NOTN:	BNE M.NOTE		;Y=0?
M.EXIT:	ADD #6,SP		;YES. RESTORE SP TO STARTING POSITION
	RTS	PC
M.NOTE:	MOV #M.PIE2,R1		;LET Y=Y*(2/PI)
	JSR	PC,MFRAC	;COMPUTE FRACTIONAL PART. RESULT WILL BE IN DEST
;STACK HAS THE INT PART (NOT FLOATED),AND DESTINATION HAS THE
;FRACTIONAL PART (KNOWN AS F)
	MOV	(SP)+,R2
	BIC #177774,R2		;AND 11(BASE 2) WITH INT
	ASL R2
	ADD #M.TAB,R2		;COMPUTE ADDRESS OF TABLE OF BRANCHES
	MOV	@R2,PC		;BRANCH TO PROPER PLACE
M.Q2:	MOV #M.ONE,R1		;LET F=-(F-1)
	MOV @SP,R0
	JSR	PC,SUBF00
M.Q3:	MOV @SP,R0		;LET F=-F
	MOV R0,R1
	JSR	PC,NEGF00
	BR M.EVAL
M.Q4:	MOV #M.ONE,R1
	MOV @SP,R0
	JSR	PC,SUBF00	;LET F=F-1
;DEST NOW EQUALS X. EVALUATE THE POLYNOMIAL
M.EVAL:	MOV @SP,R0		;GET DEST POINTER
	MOV #M.A11,R4		;POINTER TO CONSTANT TABLE
	MOV #6,R3		;NUMBER OF CONSTANTS
	JSR	PC,MSETU	;SET UP DOPOL
	JSR	PC,MDOPO
	TST 4(SP)		;WAS NFLAG SET?
	BEQ M.EXIT
	MOV @SP,R0
	MOV	R0,R1
	JSR	PC,NEGF00	;YES. LET DEST=-DEST
	BR	M.EXIT
COS00:	JSR	PC,MINIT	;CLEAR FLAGS, PUSH POINTERS
	MOV #M.PI2,R1	
	JSR	PC,ADDF00	;LET Y=PI/2+Y
	MOV @SP,R0
	BR M.SIN1
;
;SIN
M.TAB:	M.EVAL,M.Q2,M.Q3,M.Q4
M.PIE2:	140671,050574,100000	;2/PI
M.A11:	017676,106516,077756	;-.00000341817225
	175316,051777,077764	;.00016021713430
	156214,131513,077771	;-.00468162023910
	167376,050632,077775	;.07969258728630
	006165,126521,100000	;-.64596409264401
M.PI2:	166516,062207,100001	;PI/2
ATN00:	CLR -(SP)		;CLEAR NFLAG
	JSR	PC,MINIT	;CLEAR AFLAG,PUSH POINTERS
	TST 2(R0)		;DOES X=0?
	BEQ M.PA
	BGE M.P2		;X DOESN'T =0. IS  X<0?
	INC 6(SP)		;X IS MINUS. SET NFLAG
	MOV R0,R1		;LET X=-X
	JSR	PC,NEGF00
M.P2:	MOV #M.ONE+6,R1		;IS X>1, OR IS  X-1>0?
	MOV	-(R1),-(SP)
	MOV	-(R1),-(SP)
	MOV	-(R1),-(SP)
	MOV 6(SP),R0
	MOV	4(R0),-(SP)
	MOV	2(R0),-(SP)
	MOV	@R0,-(SP)
	JSR	PC,CMPF00
	BGE M.P
	ADD	#6,SP
	INC 4(SP)		;X IS >1. SET AFLAG
	MOV #M.ONE,R0		;LET X=1/X
	JSR	PC,MMOVE	;MOVE ONE ONTO THE STACK
	MOV SP,R0
	MOV 6(SP),R1
	JSR	PC,DIVF00
	MOV SP,R1		;MOVE RESULT BACK INTO DEST
	MOV 6(SP),R0
	JSR	PC,MOVF00
M.P:	ADD #6,SP		;POP PAST ONE
	MOV #M.OT32+6,R1		;IS X<2-SQT(3), OR IS X-[2-SQT(3)]<0?
	MOV	-(R1),-(SP)
	MOV	-(R1),-(SP)
	MOV	-(R1),-(SP)
	MOV 6(SP),R0
	MOV	4(R0),-(SP)
	MOV	2(R0),-(SP)
	MOV	@R0,-(SP)
	JSR	PC,CMPF00
	BLE M.BR4
	CLR 4(SP)		;IT IS. LET C=0
	CLR 2(SP)
	CLR (SP)
	BR M.EVA1
M.PA:	BR	M.TT9		;FUNNY BRANCHES DON'T GO FAR...
;LET X=[X*SQT(3)-1]/[X+SQT(3)]
;LET C=PI;6
M.BR4:	ADD	#6,SP
	MOV #M.PI6,R0
	JSR	PC,MMOVE	;MOVE PI6 ONTO THE STACK
	MOV 6(SP),R0
	JSR	PC,MMOVE	;SAVE X ON STACK
	MOV #M.ROT3,R1
	JSR	PC,MULF00	;LET DEST=DEST*SQT(3)
	MOV 14(SP),R0
	MOV #M.ONE,R1		;LET DEST=DEST-1
	JSR	PC,SUBF00
;DEST NOW ='S X*SQT(3)-1
;COMPUTE X+SQT(3)
	MOV SP,R0
	MOV #M.ROT3,R1
	JSR	PC,ADDF00
	MOV 14(SP),R0		;DIVIDE DEST BY X+SQT(3)
	MOV SP,R1
	JSR	PC,DIVF00
	ADD #6,SP		;POP UP TO C

	.EOT			;END OF TAPE 11
;
;EVAL THE POLYNOMIAL
M.EVA1:	MOV 6(SP),R0		;POINTER TO DEST
	MOV #M.TAB2,R4		;POINTER TOCONSTANT TABLE
	MOV #5,R3		;NUMBER OF CONSTANTS
	JSR	PC,MSETU	;SET UP DOPOL
	JSR	PC,MDOPO
	MOV SP,R1		;LET DEST=DEST+C
	MOV 6(SP),R0
	JSR	PC,ADDF00
	ADD #6,SP		;POP PAST C
	TST 4(SP)		;AFLAG=0?
	BEQ M.P6
	MOV @SP,R0		;NO.LET DEST=PI/2-DEST
	MOV #M.PI2,R1
	JSR	PC,SUBF00
	MOV @SP,R0
	MOV R0,R1
	JSR	PC,NEGF00
M.P6:	TST 6(SP)		;WAS NFLAG SET?
	BEQ M.TT9
	MOV @SP,R0
	MOV R0,R1
	JSR	PC,NEGF00	;LET DEST=-DEST
M.TT9:	ADD #10,SP
	CLV
	RTS	PC
;
;ARCTAN
M.OT32:	050574,042230,077777	;2-SQRT(3)
M.ROT3:	165640,067331,100001	;SQRT(3)
M.PI6:	044336,041405,100000	;PI/6
M.TAB2:	113440,060462,077775	;.09491954952
	107717,133556,077776	;-.14173460613
	155646,063141,077776	;.19996534780
	131012,125252,077777	;-.33333289364
	177776,077777,100000	;.99999999843
SQRT00:	JSR	PC,MINIT	;CLEAR NFLAG,PUSH POINTERS.
	TST 2(R0)		;IS X<0?
	BEQ	M.BR3
	BGE M.BR1
	INC 4(SP)		;YES .SET NFLAG
	MOV R0,R1
	JSR	PC,NEGF00	;LET X=-X
M.BR1:	CLR 2(SP)		;CLEAR OFLAG
	MOV @SP,R0
	CMP	(R0)+,(R0)+
	ADD	#100000,@R0
	ASR	@R0		;SHIFT EXP(X) ONCE RIGHT TO SEE IF IS ODD AND
	ADC	2(SP)
	MOV @R0,-(SP)		;TO DIVIDE IT BY TWO. SAVE IT ON STACK
	MOV	#100000,@R0	;LET EXP(X)=0.
	MOV 2(SP),R0		;SAVE X ON THE STACK
	JSR	PC,MMOVE
	MOV #M.BB,R1		;LET X=B*X
	JSR	PC,MULF00
	MOV 10(SP),R0
	MOV #M.AA,R1		;LET X=X+A
	JSR	PC,ADDF00
	JSR	PC,MAPPR	;DO FIRST APPROXIMATION
	JSR	PC,MAPPR	;DO SECOND ITERATION
	JSR	PC,MAPPR	;BOY OH BOY ARE WE PRECISE TODAY!
	ADD 6(SP),4(R0)		;ADD SAVED EXPOONENT TO EXP(DEST)
	ADD #10,SP
	TST 2(SP)		;WAS OFLAG SET
	BEQ M.BR2
	MOV #M.ROOT,R1		;YES. MULT BY SQT(2)
	JSR	PC,MULF00
M.BR2:	TST 4(SP)		;WAS NFLAG SET?
	BEQ	M.BR3
	SQRERR
M.BR3:	ADD	#6,SP
	CLV
	RTS	PC
;SUBROUTINE PERFORMS AN APPROXIMATION
;OF THE FORM Y0=.5(Y0+X/Y0)
;
MAPPR:	MOV	SP,R0
	TST (R0)+		;ADD 2 TO R0
	JSR	PC,MMOVE	;SAVE X ON STACK
	MOV SP,R0		;SET UP DESTINATION
	MOV 20(SP),R1		;SET UP SOURCE
	JSR	PC,DIVF00	;COMPUTE X/Y0
	MOV SP,R1
	MOV 20(SP),R0
	JSR	PC,ADDF00	;LET Y0=Y0+X/Y0
	MOV 20(SP),R0
	DEC 4(R0)
	ADD #6,SP
	RTS	PC
;
;SQUARE ROOT
M.ROOT:	074626,055202,100001	;SQRT(2)
M.AA:	125672,065324,077777	;.41730760
M.BB:	067102,045612,100000	;.59016207
;
; MAIN DATA STORAGE AREA
;
WORK:	WORK03
USER	=	.
;
;
; BASIC INITIALIZATION -- STORED IN USER AREA
;	THIS CODE IS DESTROYED AFTER IT IS USED ONCE AND IS
;	THEREFORE NON-REUSEABLE!!
.	=	USER
;
TTYBUF:	.WORD	TTY0	;DEVICE ADDRESS
	.WORD	TP1	;START
	.WORD	TP2	;END
	.WORD	TP1	;GET
	.WORD	TP1	;PUT
	.WORD	0	;STATUS

ECOBUF:	.WORD	TTY0	;DEVICE ADDRESS
	.WORD	EB1	;START
	.WORD	EB2	;END
	.WORD	EB1	;GET
	.WORD	EB1	;PUT
	.WORD	0	;STATUS

KBDBUF:	.WORD	KBD0	;DEVICE ADDRESS
	.WORD	KB1	;START
	.WORD	KB2	;END
	.WORD	KB1	;GET
	.WORD	KB1	;PUT
	.WORD	0	;STATUS
	.WORD	0	;SPECIAL WORD

HSRBUF:	.WORD	HSR0	;DEVICE ADDRESS
	.WORD	HR1	;START ADDRESS
	.WORD	HR2	;END ADDRESS
	.WORD	HR1	;GET ADDRESS
	.WORD	HR1	;PUT ADDRESS
	.WORD	0	;STATUS
	.WORD	0	;SPECIAL WORD

HSPBUF:	.WORD	HSP0	;DEVICE ADDRESS
	.WORD	HP1	;START
	.WORD	HP2	;END
	.WORD	HP1	;GET
	.WORD	HP1	;PUT
	.WORD	0	;STATUS

LPTBUF:	.WORD	LPT0	;DEVICE ADDRESS
	.WORD	LP1	;START
	.WORD	LP2	;END
	.WORD	LP1	;GET
	.WORD	LP1	;PUT
	.WORD	0	;STATUS

EB1:	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
EB2=.-1
TP1:	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
TP2=.-1
KB1:	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
KB2=.-1
HR1:	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
HR2=.-1
HP1:	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
HP2=.-1
LP1:	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	0
LP2=.-1

;
; SUPER WONDERFUL USER CHANGER AROUNDER TO NEXT ONE.
;
;	THIS ROUTINE SAVES THE INFORMATION ABOUT THE CURRENT
;	USER AND SETS UP THE INFORMATION FOR THE NEXT ONE.
;	TIME - 78 MICROSECONDS PER CALL.
;
IOWAIT:	240			;NO-OP MAY BE CHANGED BY INITIALIZATION
NXTUSR:	MOV	R0,-(SP)	;SAVE R0 ON STACK SO WE CAN USE IT
	MOV	WORK,R0		;FIND OUT WHERE TO SAVE GOODIES
	ADD	#SLOT,R0	;GET ADDRESS OF REGISTER SAVE AREA
	MOV	R1,-(R0)	;SAVE REGISTERS
	MOV	R2,-(R0)	;R1
	MOV	R3,-(R0)		;THROUGH
	MOV	R4,-(R0)	;R5
	MOV	R5,-(R0)	;    INCLUSIVELY
	MOV	SP,-(R0)	;NOW SAVE THE STACK POINTER ITSELF
	MOV	-(R0),R0	;GET LINK TO NEW AREA FOR RESTORE
	MOV	(R0)+,SP	;AND SET UP A NEW STACK POINTER
	MOV	(R0)+,R5	;NOW SET
	MOV	(R0)+,R4	;UP
	MOV	(R0)+,R3		;THE
	MOV	(R0)+,R2	;VARIOUS
	MOV	(R0)+,R1	;REGISTERS
	SUB	#SLOT,R0	;FIND WORK ADDRESS
	MOV	R0,WORK		;NOW POINT TO WORKING BUFFER
	MOV	(SP)+,R0	;RESTORE R0
	RTS	PC		;AND RETURN WITH NEW USER RUNNING
;
; USER #0 SAVE AREA
;
LINK:	LINK1+2
STP:	0
.	=	.+12
	.WORD	SLT0	;SLOT TABLE #0
	.WORD	0	;HIGH LINE NUMBER
	.WORD	0	;LINE NUMBER
	.WORD	0	;START OF USER STACK
	.WORD	0	;RUN FLAG
	.WORD	0	;END OF TEXT
	.WORD	0	;DATA STATEMENT POINTER
	.WORD	0	;OLD FLGA
	.WORD	0	;SAVE FLAG
	.WORD	1	;RANDOMIZE WORD
	.WORD	37474	;END OF USER SPACE
	.WORD	13507	;RANDOM NUMBER COUNTER
	.WORD	0	;INPUT AND OUTPUT DEVICE
	.WORD	0	;USER I/O MASK
	.WORD	0	;"INPUT" DEVICE
	.WORD	0	;TEMPORARY LINE NUMBER
WORK00:
.	=	.+122
SLT0:	0
	0
	0
	0
END0	=	.
;
; USER #1 BUFFERS
;
T1BUF:	TTY1
	T11
	T12
	T11
	T11
	0
E1BUF:	TTY1
	E11
	E12
	E11
	E11
	0
K1BUF:	KBD1
	K11
	K12
	K11
	K11
	0
	0
T11:
.	=	.+120
T12	=	.-1
;
E11:
.	=	.+50
E12	=	.-1
;
K11:
.	=	.+120
K12	=	.-1
	.EVEN
;
;
; USER #1 SAVE AREA
;
LINK1:	LINK2+2
STP1:	0
.	=	.+12
	.WORD	SLT1	;SLOT TABLE #1
	.WORD	0	;HIGH LINE NUMBER
	.WORD	0	;LINE NUMBER
	.WORD	0	;START OF USER STACK
	.WORD	0	;RUN FLAG
	.WORD	0	;END OF TEXT
	.WORD	0	;DATA STATEMENT POINTER
	.WORD	0	;OLD FLGA
	.WORD	0	;SAVE FLAG
	.WORD	1	;RANDOMIZE WORD
	.WORD	37474	;END OF USER SPACE
	.WORD	13507	;RANDOM NUMBER COUNTER
	.WORD	0	;INPUT AND OUTPUT DEVICE
	.WORD	0	;USER I/O MASK
	.WORD	0	;"INPUT" DEVICE
	.WORD	0	;TEMPORARY LINE NUMBER
WORK01:
.	=	.+122
SLT1:	0
	0
	0
	0

END1	=	.
;
;
; USER #2 BUFFERS
;
T2BUF:	TTY2
	T21
	T22
	T21
	T21
	0
E2BUF:	TTY2
	E21
	E22
	E21
	E21
	0
K2BUF:	KBD2
	K21
	K22
	K21
	K21
	0
	0
T21:
.	=	.+120
T22	=	.-1
;
E21:
.	=	.+50
E22	=	.-1
;
K21:
.	=	.+120
K22	=	.-1
	.EVEN
;
; USER #2 SAVE AREA
;
LINK2:	LINK3+2
STP2:	0
.	=	.+12
	.WORD	SLT2	;SLOT TABLE #2
	.WORD	0	;HIGH LINE NUMBER
	.WORD	0	;LINE NUMBER
	.WORD	0	;START OF USER STACK
	.WORD	0	;RUN FLAG
	.WORD	0	;END OF TEXT
	.WORD	0	;DATA STATEMENT POINTER
	.WORD	0	;OLD FLGA
	.WORD	0	;SAVE FLAG
	.WORD	1	;RANDOMIZE WORD
	.WORD	37474	;END OF USER SPACE
	.WORD	13507	;RANDOM NUMBER COUNTER
	.WORD	0	;INPUT AND OUTPUT DEVICE
	.WORD	0	;USER I/O MASK
	.WORD	0	;"INPUT" DEVICE
	.WORD	0	;TEMPORARY LINE NUMBER
WORK02:
.	=	.+122
SLT2:	0,0,0,0
END2	=	.
;
;
; USER #3 BUFFERS
;
T3BUF:	TTY3
	T31
	T32
	T31
	T31
	0
E3BUF:	TTY3
	E31
	E32
	E31
	E31
	0
K3BUF:	KBD3
	K31
	K32
	K31
	K31
	0
	0
T31:
.	=	.+120
T32	=	.-1
;
E31:
.	=	.+50
E32	=	.-1
;
K31:
.	=	.+120
K32	=	.-1
	.EVEN
;
; USER #3 SAVE AREA
;
LINK3:	LINK4+2
STP3:	0
.	=	.+12
	.WORD	SLT3	;SLOT TABLE #3
	.WORD	0	;HIGH LINE NUMBER
	.WORD	0	;LINE NUMBER
	.WORD	0	;START OF USER STACK
	.WORD	0	;RUN FLAG
	.WORD	0	;END OF TEXT
	.WORD	0	;DATA STATEMENT POINTER
	.WORD	0	;OLD FLGA
	.WORD	0	;SAVE FLAG
	.WORD	1	;RANDOMIZE WORD
	.WORD	37474	;END OF USER SPACE
	.WORD	13507	;RANDOM NUMBER COUNTER
	.WORD	0	;INPUT AND OUTPUT DEVICE
	.WORD	0	;USER I/O MASK
	.WORD	0	;"INPUT" DEVICE
	.WORD	0	;TEMPORARY LINE NUMBER
WORK03:
.	=	.+122
SLT3:	0,0,0,0
END3	=	.
;
; USER #4 BUFFERS
;
T4BUF:	TTY4
	T41
	T42
	T41
	T41
	0
E4BUF:	TTY4
	E41
	E42
	E41
	E41
	0
K4BUF:	KBD4
	K41
	K42
	K41
	K41
	0
	0
T41:
.	=	.+120
T42	=	.-1
;
E41:
.	=	.+50
E42	=	.-1
;
K41:
.	=	.+120
K42	=	.-1
	.EVEN
;
; USER #4 SAVE AREA
;
LINK4:	LINK5+2
STP4:	0
.	=	.+12
	.WORD	SLT4	;SLOT TABLE #4
	.WORD	0	;HIGH LINE NUMBER
	.WORD	0	;LINE NUMBER
	.WORD	0	;START OF USER STACK
	.WORD	0	;RUN FLAG
	.WORD	0	;END OF TEXT
	.WORD	0	;DATA STATEMENT POINTER
	.WORD	0	;OLD FLGA
	.WORD	0	;SAVE FLAG
	.WORD	1	;RANDOMIZE WORD
	.WORD	37474	;END OF USER SPACE
	.WORD	13507	;RANDOM NUMBER COUNTER
	.WORD	0	;INPUT AND OUTPUT DEVICE
	.WORD	0	;USER I/O MASK
	.WORD	0	;"INPUT" DEVICE
	.WORD	0	;TEMPORARY LINE NUMBER
WORK04:
.	=	.+122
SLT4:	0,0,0,0
END4	=	.
;
; USER #5 BUFFERS
;
T5BUF:	TTY5
	T51
	T52
	T51
	T51
	0
E5BUF:	TTY5
	E51
	E52
	E51
	E51
	0
K5BUF:	KBD5
	K51
	K52
	K51
	K51
	0
	0
T51:
.	=	.+120
T52	=	.-1
;
E51:
.	=	.+50
E52	=	.-1
;
K51:
.	=	.+120
K52	=	.-1
	.EVEN
;
; USER #5 SAVE AREA
;
LINK5:	LINK6+2
STP5:	0
.	=	.+12
	.WORD	SLT5
	.WORD	0	;HIGH LINE NUMBER
	.WORD	0	;LINE NUMBER
	.WORD	0	;START OF USER STACK
	.WORD	0	;RUN FLAG
	.WORD	0	;END OF TEXT
	.WORD	0	;DATA STATEMENT POINTER
	.WORD	0	;OLD FLGA
	.WORD	0	;SAVE FLAG
	.WORD	1	;RANDOMIZE WORD
	.WORD	37474	;END OF USER SPACE
	.WORD	13507	;RANDOM NUMBER COUNTER
	.WORD	0	;INPUT AND OUTPUT DEVICE
	.WORD	0	;USER I/O MASK
	.WORD	0	;"INPUT" DEVICE
	.WORD	0	;TEMPORARY LINE NUMBER
WORK05:
.	=	.+122
SLT5:	0,0,0,0
END5	=	.
;
; USER #6 BUFFERS
;
T6BUF:	TTY6
	T61
	T62
	T61
	T61
	0
E6BUF:	TTY6
	E61
	E62
	E61
	E61
	0
K6BUF:	KBD6
	K61
	K62
	K61
	K61
	0
	0
T61:
.	=	.+120
T62	=	.-1
;
E61:
.	=	.+50
E62	=	.-1
;
K61:
.	=	.+120
K62	=	.-1
	.EVEN
;
; USER #6 SAVE AREA
;
LINK6:	LINK7+2
STP6:	0
.	=	.+12
	.WORD	SLT6
	.WORD	0	;HIGH LINE NUMBER
	.WORD	0	;LINE NUMBER
	.WORD	0	;START OF USER STACK
	.WORD	0	;RUN FLAG
	.WORD	0	;END OF TEXT
	.WORD	0	;DATA STATEMENT POINTER
	.WORD	0	;OLD FLGA
	.WORD	0	;SAVE FLAG
	.WORD	1	;RANDOMIZE WORD
	.WORD	37474	;END OF USER SPACE
	.WORD	13507	;RANDOM NUMBER COUNTER
	.WORD	0	;INPUT AND OUTPUT DEVICE
	.WORD	0	;USER I/O MASK
	.WORD	0	;"INPUT" DEVICE
	.WORD	0	;TEMPORARY LINE NUMBER
WORK06:
.	=	.+122
SLT6:	0,0,0,0
END6	=	.
;
; USER #7 BUFFERS
;
T7BUF:	TTY7
	T71
	T72
	T71
	T71
	0
E7BUF:	TTY7
	E71
	E72
	E71
	E71
	0
K7BUF:	KBD7
	K71
	K72
	K71
	K71
	0
	0
T71:
.	=	.+120
T72	=	.-1
;
E71:
.	=	.+50
E72	=	.-1
;
K71:
.	=	.+120
K72	=	.-1
	.EVEN
;
; USER #7 SAVE AREA
;
LINK7:	LINK+2
STP7:	0
.	=	.+12
	.WORD	SLT7
	.WORD	0	;HIGH LINE NUMBER
	.WORD	0	;LINE NUMBER
	.WORD	0	;START OF USER STACK
	.WORD	0	;RUN FLAG
	.WORD	0	;END OF TEXT
	.WORD	0	;DATA STATEMENT POINTER
	.WORD	0	;OLD FLGA
	.WORD	0	;SAVE FLAG
	.WORD	1	;RANDOMIZE WORD
	.WORD	37474	;END OF USER SPACE
	.WORD	13507	;RANDOM NUMBER COUNTER
	.WORD	0	;INPUT AND OUTPUT DEVICE
	.WORD	0	;USER I/O MASK
	.WORD	0	;"INPUT" DEVICE
	.WORD	0	;TEMPORARY LINE NUMBER
WORK07:
.	=	.+122
SLT7:	0,0,0,0
END7	=	.
;
; BASIC INITIALIZATION CODE
;	THIS IS A ONE SHOT ROUTINE WHICH CONFIGURES THE SYSTEM
;	AS DESCRIBED BY THE HARDWARE PRESENT ON THE SYSTEM
;	AND THE USER'S DESIRED NUMBER OF JOBS.
;
;	THIS ROUTINE:
;
;		1.  DETERMINES MACHINE SIZE
;		2.  DETERMINES WHAT TELETYPES REALLY EXIST
;		3.  DETERMINES IF HSR/P AND LPT ARE PRESENT
;		4.  TAKES USER REQUIREMENTS FOR NUMBER OF JOBS
;		    AND PARTITIONS FREE CORE TO ACCOMODATE THEM.
;		    IF ONLY ONE USER IS REQUESTED, THE USER SWAP
;		    MANAGER IS DESTROYED TO IMPROVE SPEED.
;
BASIC:	MOV	#WORK00,R1
	MOV	ENDUSR(R1),SP
	MOV	#BAS001,TRP04
	CMP	-(SP),-(SP)
	MOV	#160000,R1
BAS001:	CMP	(SP)+,(SP)+
	MOV	-(R1),@R1
	SUB	#302,R1
	MOV	#BAS010,TRP04	;SET UP FOR TTY CHECK
	MOV	#BAS011,R0	;GET LIST OF ONES THAT SHOULD BE.
BAS015:	MOV	@R0,R2		;GET ADDRESS
	BEQ	BAS014		;EXIT IF ALL THERE
	MOVB	@R2,@R2		;CHECK FOR PRESENCE
	TST	(R0)+		;LOOK AT NEXT ONE
	BR	BAS015
BAS010:	CMP	(SP)+,(SP)+	;TRAP OCCURED
	CLR	@BAS012-BAS011(R0) ;TURN OFF KBD
	CLR	@BAS013-BAS011(R0) ;TURN OFF TTY
	ADD	#12-BAS011,R0
BAS017:	MOV	#100000,ATTACH(R0)	;MAKE THE DEVICE ILLEGAL
	TST	(R0)+
	CMP	R0,#ATT		;ALL DONE
	BLT	BAS017		;NO
	BR	BAS014		;DON'T LOOK FARTHER
BAS011:	TTY1
	TTY2
	TTY3
	TTY4
	TTY5
	TTY6
	TTY7
	0
BAS012:	K1
	K2
	K3
	K4
	K5
	K6
	K7
BAS013:	T1
	T2
	T3
	T4
	T5
	T6
	T7
BAS014:	MOV	#BAS14A,R0	;GET DEVICE LIST
	MOV	#BAS018,TRP04	;SET UP FOR CHECK
BAS019:	MOV	@R0,R2		;GET DEVICE ADDRESS
	BEQ	BAS020		;CHECK IS COMPLETE
	MOVB	@R2,@R2		;SEE IF DEVICE IS THERE
BAS19A:	TST	(R0)+		;IT IS, GO CHECK THE NEXT ONE
	BR	BAS019		;RE-LOOP
BAS018:	CMP	(SP)+,(SP)+	;TRAP OCCURED
	MOV	#100000,@BAS14B-BAS14A(R0) ; SET NOT PRESENT
	BR	BAS19A
BAS020:	MOV	#TALK,R0	;GET MESSAGE
STRT01:	JSR	PC,PRTLN	;AND WELCOME USER
	JSR	PC,GETCH	;GET USER COUNT
	CMPB	R2,#'1		;IS IT IN RANGE???
	BLT	ERR		;NO, ASK AGAIN
	CMPB	R2,#'8		;TRY AGAIN
	BGT	ERR		;OUT OF RANGE HERE TOO
	BIC	#177760,R2	;CONVERT TO BINARY
	MOV	R2,USRCT	;SAVE COUNT
	ADD	#3,R2		;TAKE # OF REQUESTED JOBS
	ASL	R2		;CONVERT TO SLOT INDEX
	TST	ATTACH(R2)	;DO WE HAVE
	BPL	STRT03		;ENOUGH TELETYPES??
	MOV	#TALK3,R0	;NO, TELL USER OF MISTAKE
	JSR	PC,PRTLN	;AND
	BR	ERR
STRT03:	MOV	#TALK2,R0	;BE
	JSR	PC,PRTLN	;NEAT AND HELP USER ALONG
	BR	STRT02
BAS14A:	HSR0
	HSP0
	LPT0
	0
BAS14B:	ATT1
	ATT2
	ATT3
ERR:	MOV	#TALK1,R0	;TELL USER AGAIN
	BR	STRT01		;AND AGAIN IF NECESSARY
BAS016:	END0
	END1
	END2
	END3
	END4
	END5
	END6
	END7
STRT02:	MOV	USRCT,R2		;GET NUMBER OF USERS
	DEC	R2		;GET THE
	ASL	R2		;ENDING
	MOV	BAS016(R2),R0	;OF THE TABLES
	MOV	R1,SP
	MOV	#TRP04+2,TRP04
	SUB	R0,R1	;TOTAL LENGTH
	SUB	#4,R1
	CMP	USRCT,#1	;SINGLE USER??????????
	BEQ	BAS004		;YES, DON'T SPLIT AREA
	MOV	R0,-(SP)	;SAVE START ADDRESS
	MOV	R1,R3		;SET
	CLR	R0		; UP
	CLR	R1		;  THE TOTAL LENGTH AS
	CLR	R2		;   THE DIVIDEND
	MOV	USRCT,R5	;AND DIVIDE
	CLR	R4		; BY
	JSR	PC,MDPID	;  THE NUMBER OF USERS
	MOV	R3,R1		;GET THE INDIVIDUAL LENGTH
	MOV	(SP)+,R0	;RESTORE START ADDRESS
BAS004:	BIC	#1,R1
	MOV	#-2,TEMP
	MOV	#1,R2		;SET USER MASK
BAS04A:	ADD	#2,TEMP		;ADVANCE USER POINTER
	MOV	TEMP,R5		;GET THE POINTER
	MOV	DEV(R5),R3	;GET DEVICE SLOT
	MOV	GOLST(R5),R4	;GET STACK POINTER
	MOV	WK(R5),R5	;GET WORK ADDRESS
	MOV	R5,WORK		;REMEMBER LAST WORK ADDRESS
	JSR	PC,UGEN		;GO GENERATE A USER AREA
	ASL	R2		;GET NEW USER MASK
	MOV	TEMP,R5		;COMPUTE
	DEC	USRCT		;DECREMENT USER'S DESIRED COUNT
	BGT	BAS04A		;LOOP UNTIL DONE
	MOV	GOLST(R5),R3	; LINK
	SUB	#2,R3		;  ADDRESS
	MOV	#LINK+2,@R3	;STORE THE LINK ADDRESS
	CMP	R4,#STP		;IS THIS A SINGLE USER SYSTEM?
	BNE	BAS005		;NO
	MOV	#1,IOWAIT	;YES, DESTROY THE USER SWAP HANDLER
	MOV	#207,NXTUSR	; WITH A "WAIT" AND AN "RTS PC"
	CLR	GOLST		;SET SINGLE USER RESTART
	JMP 	RESTRT		;NOW START THE SYSTEM
BAS005:	ADD	#2,R5		;SET UP THE
	CLR	GOLST(R5)	; PROPER RESTART COUNT
	MOV	@R4,SP		;SET THE PROPER STACK
	TST	(SP)+		;POP ONE JUNK ITEM
	RTS	PC		;HOCUS-POCUS, IT JUST STARTED
;
; THIS ROUTINE IS USED TO DO THE ACTUAL SET-UP OF A USER AREA
;
UGEN:	MOV	R0,USR(R5)	;SAVE START ADDRESS
	MOVB	#12,@R0		;STORE A TERMINATOR
	ADD	R1,R0		;COMPUTE LENGTH OF THE AREA
	MOV	R0,ENDUSR(R5)	;STORE ENDING ADDRESS
	MOV	#RESTRT,-(R0)	;SET UP RESTART
	CLR	-(R0)		;CLEAR FUDGE WORD
	MOV	R2,USRMSK(R5)	;SET UP THE USER MASK
	MOV	R3,IODEV(R5)	;SET UP THE I/O DEVICE
	MOV	R0,@R4		;REMEMBER THE STACK
	CMP	(R0)+,(R0)+	;RESET THE R0 POINTER
	RTS	PC
;
; TABLES USED FOR SETUP
;
DEV:	4,5,6,7,10,11,12,13	;IO DEVICE SLOTS
WK:	WORK00,WORK01
	WORK02,WORK03
	WORK04,WORK05
	WORK06,WORK07	;LIST OF USER WORK AREA POINTERS
;
;
;
;
; PRINT CHARACTER IN R2
;
PRTCH:	TSTB	TTY0		;WAIT
	BPL	PRTCH		;UNTIL READY
	MOVB	R2,TTY0+2	;PRINT THE CHARACTER
	RTS	PC
;
; PRINT ZERO TERMINATED LINE POINTED TO BY R0
;
PRT01:	JSR	PC,PRTCH	;PRINT A CHARACTER
PRTLN:	MOVB	(R0)+,R2	;GET A CHARACTER
	BNE	PRT01		;PRINT IT IF NON-ZERO
	RTS	PC		;OTHERWISE RETURN
;
; GET AHCARACTER INTO R2
;
GETCH:	TSTB	KBD0		;WAIT FOR
	BPL	GETCH		;COMPLETION OF CHARACTER
	MOVB	KBD0+2,R2	;GET A CHARACTER
	BIC	#177600,R2	;CLEAR TRASH
	JSR	PC,PRTCH	;ECHO IT
	RTS	PC		;THEN RETURN
TALK:	.BYTE	15,12,12
	.ASCII	/PDP-11 1-8 USER BASIC, V001A/
TALK1:	.BYTE	15,12
	.ASCII	/HOW MANY USERS?/
	.BYTE	0
TALK2:	.BYTE	15,12,12,0
TALK3:	.BYTE	15,12
	.ASCII	/NOT ENOUGH TELETYPES./
	.BYTE	0
	.EVEN
USRCT:	0			;NUMBER OF USERS
TEMP:	0		;TEMPORARY INITIALIZATION CELL
	.END	BASIC		;END OF TAPE 12
    